﻿

'*******************************************************************
' Program: Data Center Visio Rack Tool
' Author: Albert E Edlund
' Date:
'
' Purpose:
'*******************************************************************


Imports System
Imports System.Text
Imports System.Collections

Imports Microsoft.VisualBasic.Strings
Imports System.Data
Imports System.Reflection
Imports System.Xml
Imports ADODB
Imports ADODB.ObjectStateEnum



' just as a short cut
Imports Microsoft.Office.Interop.Visio
Imports System.Runtime.InteropServices

Imports Microsoft.Practices.EnterpriseLibrary.Common
Imports Microsoft.Practices.EnterpriseLibrary.ExceptionHandling
Imports Microsoft.Office.Interop
Imports Microsoft.Practices.EnterpriseLibrary.ExceptionHandling.Logging




Public Class clsVisioSupport

#Region " Properties and definitions "


    ' these are used in the add right mouse click section
    Private Const ContextRightMouseAction As String = "solution=DC_Rack "
    Private Const ContextBeginMarker As String = "/"
    Private Const ContextCommand As String = "cmd="
    Private Const DividerBarPrefix As String = "_"
    Private Const AddToBottomPrefix As String = "%"
    Private Const AcceleratorPrefix As String = "&"



    '********* visio snippet vb.net vis0041vb ******************
    Private _drawingApplication As Microsoft.Office.Interop.Visio.Application
    Public Property drawingApplication() As Microsoft.Office.Interop.Visio.Application
        Get
            Return Me._drawingApplication
        End Get
        Set(ByVal value As Microsoft.Office.Interop.Visio.Application)
            If (value Is Nothing) Then
                Throw New System.ArgumentNullException("ApplicationValueIsNull", _
                    "drawingApplication is Null.")
            End If
            Me._drawingApplication = value
        End Set
    End Property


    '********* visio snippet vb.net vis0043vb ******************
    Private _drawingDocument As Microsoft.Office.Interop.Visio.Document
    Public Property drawingDocument() As Microsoft.Office.Interop.Visio.Document
        Get
            Return Me._drawingDocument
        End Get
        Set(ByVal value As Microsoft.Office.Interop.Visio.Document)
            If (value Is Nothing) Then
                Throw New System.ArgumentNullException("DocumentValueIsNull", _
                    "drawingDocument is Null.")
            End If
            Me._drawingDocument = value
        End Set
    End Property


    '********* visio snippet vb.net vis0045vb ******************
    Private _drawingWindow As Microsoft.Office.Interop.Visio.Window
    Public Property drawingWindow() As Microsoft.Office.Interop.Visio.Window
        Get
            Return Me._drawingWindow
        End Get
        Set(ByVal value As Microsoft.Office.Interop.Visio.Window)
            If (value Is Nothing) Then
                Throw New System.ArgumentNullException("WindowValueIsNull", _
                    "drawingWindow is Null.")
            End If
            Me._drawingWindow = value
        End Set
    End Property

    '********* visio snippet vb.net vis0044vb ******************
    Private _drawingPage As Microsoft.Office.Interop.Visio.Page
    Public Property drawingPage() As Microsoft.Office.Interop.Visio.Page
        Get
            Return Me._drawingPage
        End Get
        Set(ByVal value As Microsoft.Office.Interop.Visio.Page)
            If (value Is Nothing) Then
                Throw New System.ArgumentNullException("PageValueIsNull", _
                    "drawingPage is Null.")
            End If
            Me._drawingPage = value
        End Set
    End Property

    Public m_customstencilpath As String
    Public Property _CustomStencilPath() As String
        Get
            Return Me.m_customstencilpath
        End Get
        Set(ByVal value As String)
            Me.m_customstencilpath = value
        End Set
    End Property

#End Region

#Region " testing code "

    Private Shared Sub PrintValues(ByVal myList As IEnumerable, _
        ByVal mySeparator As Char)
        Dim obj As [Object]
        For Each obj In myList
            Console.Write("{0}{1}", mySeparator, obj)
        Next obj
        Console.WriteLine()
    End Sub 'PrintValues

    Public Sub DisplayArrayListIndexAndValues(ByVal myArr As ArrayList)
        Dim sbArray As New StringBuilder
        Dim strLine As String
        Dim i As Integer
        For i = 0 To myArr.Count - 1
            strLine = String.Format("   [{0}] : {1}", i, myArr(i)) & " " & myArr(i).GetType.ToString & vbCrLf
            sbArray.Append(strLine)
        Next i
        MsgBox(" show array " & vbCrLf & sbArray.ToString)
    End Sub

#End Region

#Region " Generic Visio Call Examples "


    '********* visio snippet vb.net vis0103vb ******************  
    Public Const defaultOpen As Microsoft.Office.Interop.Visio.VisOpenSaveArgs = _
                Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenRO _
                + Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked

    Public Function visioOpenStencil _
        (ByVal visApp As Microsoft.Office.Interop.Visio.Application, _
        ByVal stencilName As String, _
        ByVal openArguments As Microsoft.Office.Interop.Visio.VisOpenSaveArgs) _
        As Boolean

        Dim blnReturn As Boolean = False

        Try

            If openArguments = Nothing Then openArguments = defaultOpen

            If System.IO.File.Exists(stencilName) = True Then
                visApp.Documents.OpenEx(stencilName, _
                    (CShort(openArguments)))

                blnReturn = True
            End If

        Catch com As COMException
            ' add com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' add exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return blnReturn

    End Function


    '********* visio snippet vb.net vis0099vb ******************
    Public Function TestStencilLoaded _
            (ByVal visApp As Microsoft.Office.Interop.Visio.Application, _
            ByVal strStencil As String) _
            As Boolean


        Dim blnReturn As Boolean = False

        Try
            Dim vsoDocs As Microsoft.Office.Interop.Visio.Documents = visApp.Documents
            Dim intDoc As Integer
            Dim strDocName As String

            For intDoc = 1 To vsoDocs.Count
                strDocName = vsoDocs.Item(intDoc).Name
                If LCase(strDocName) = LCase(strStencil) Then
                    blnReturn = True
                    Exit For
                End If
            Next intDoc

        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return blnReturn

    End Function

#End Region

#Region " Cell manipulation "





    '********* visio snippet vb.net vis0090vb ******************

    Public Sub ForceUserProperty _
                  (ByRef visShape As Microsoft.Office.Interop.Visio.Shape, _
                  ByVal strProperty As String, _
                  ByVal strValue As String)

        Dim visCell As Cell = Nothing
        Dim strPropertyName As String = "user." & strProperty



        Try
            Dim strPrompt As String = ""

            If visShape.CellExists(strPropertyName, False) = False Then
                AddUserPropertyToShape( _
                        visShape, _
                        strProperty, _
                        strProperty, _
                        strProperty, _
                        strValue, strPrompt)
            Else
                visCell = visShape.Cells(strPropertyName)
                visCell.FormulaU = strValue
            End If




        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            'insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try


    End Sub



    '********* visio snippet vb.net vis0088vb ******************
    Public Function AddUserPropertyToShape _
                (ByVal visShape As Microsoft.Office.Interop.Visio.Shape, _
                ByVal strLocalRowName As String, _
                ByVal strRowNameU As String, _
                ByVal strLabelName As String, _
                ByVal strValue As String, _
                ByVal strPrompt As String) _
                As Boolean

        Dim vsoCell As Microsoft.Office.Interop.Visio.Cell
        Dim intRowIndex As Integer
        Dim blnReturn As Boolean = False

        Try

            Dim strPropertyName As String = "user." & strLocalRowName
            If visShape.CellExists(strPropertyName, False) = True Then Return True

            If visShape.SectionExists(VisSectionIndices.visSectionUser, False) = False Then
                visShape.AddSection(VisSectionIndices.visSectionUser)
            End If

            ' get an available row number
            intRowIndex = visShape.AddNamedRow(VisSectionIndices.visSectionUser, _
                 strLocalRowName, _
                 VisRowIndices.visRowUser)

            ' add a prompt
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionUser, _
                VisRowIndices.visRowUser + intRowIndex, VisCellIndices.visUserPrompt)
            If strPrompt = Nothing Then
                SetCellValueToString(vsoCell, "")
            Else
                SetCellValueToString(vsoCell, strPrompt)
            End If

            If (strLocalRowName <> strRowNameU And _
                Len(strRowNameU) > 0) Then
                vsoCell.RowNameU = strRowNameU
            End If

            ' add a value
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionUser, _
                VisRowIndices.visRowUser + intRowIndex, VisCellIndices.visUserValue)
            If strValue = Nothing Then
                SetCellValueToString(vsoCell, "")
            Else
                SetCellValueToString(vsoCell, strValue)
            End If

            blnReturn = True

        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return blnReturn


    End Function


    '********* visio snippet vb.net vis0080vb ******************
    Public Sub ForceShapeData _
              (ByRef visShape As Visio.Shape, _
              ByVal strProperty As String, _
              ByVal strValue As String, _
              ByVal strAttrSet As String)

        Dim visCell As Visio.Cell = Nothing
        Dim strPropertyName As String = "prop." & strProperty

        Try

            If visShape.CellExists(strPropertyName, False) = False Then
                AddCustomProperty( _
                        visShape, _
                        strProperty, _
                        strProperty, _
                        strProperty, _
                        Nothing, Nothing, Nothing, Nothing, Nothing, _
                        strAttrSet)
            End If
            visCell = visShape.Cells(strPropertyName)
            SetCellValueToString(visCell, strValue)


        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

    End Sub




    Public Function StringToFormulaForString(ByVal strIn As String) _
            As String

        ' StringToFormulaForString
        '
        ' Abstract - Convert the input string to a Visio string by
        ' replacing each 'double quote'(") with a 'double double
        ' quote'("") and adding a ("") around the entire string.
        '
        ' Parameters
        ' strIn         Input string that will to be converted to
        '               Visio String
        '
        ' Return Value  Returns the converted Visio string

        Dim strResult As String
        Dim strMultiQuote As String = Chr(34) & Chr(34) & Chr(34)

        Try
            strResult = strIn

            ' Replace all (") with ("").
            strResult = Replace(strResult, Chr(34), Chr(34) & Chr(34))

            ' Add ("") around the whole string.
            strResult = Chr(34) & strResult & Chr(34)

            StringToFormulaForString = strResult

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
            Return ""
        End Try

    End Function

    Public Function ReadANamedCustomProperty( _
        ByVal customPropertyShape As Visio.Shape, _
        ByVal cellName As String, _
        Optional ByVal isLocalName As Boolean = False) _
        As String

        Const CUST_PROP_PREFIX As String = "Prop."

        Dim propName As String
        Dim exists As Boolean
        Dim customPropertyCell As Microsoft.Office.Interop.Visio.Cell = Nothing
        Dim visioApplication As Microsoft.Office.Interop.Visio.Application

        visioApplication = CType(customPropertyShape.Application,  _
            Microsoft.Office.Interop.Visio.Application)

        Try

            ' Verify that all incoming string parameters are not of zero 
            ' length, except for the ones that have default values as ""
            ' and the output parameters.
            If (cellName.Length() = 0) Then

                Throw New System.ArgumentNullException("cellName", _
                    "Zero length string input.")
            End If

            ' Custom properties have a prefix of "Prop".
            propName = CUST_PROP_PREFIX & cellName

            ' If the custom property exists, get the value of the cell from
            ' the shape.
            If isLocalName Then

                exists = CBool(customPropertyShape.CellExists(propName, _
                    CShort(Microsoft.Office.Interop.Visio.VisExistsFlags. _
                    visExistsAnywhere)))

                ' If the cell exists, the cell variable gets a valid value.
                If exists Then

                    customPropertyCell = customPropertyShape.Cells(propName)
                End If
            Else

                exists = CBool(customPropertyShape.CellExistsU(propName, _
                    CShort(Microsoft.Office.Interop.Visio.VisExistsFlags. _
                    visExistsAnywhere)))

                ' If the cell exists, the cell variable gets a valid value
                If exists Then
                    customPropertyCell = customPropertyShape.CellsU( _
                        propName)
                End If
            End If

            If exists Then
                ReadANamedCustomProperty = customPropertyCell.ResultStr( _
                    Microsoft.Office.Interop.Visio.VisUnitCodes.visNoCast)
            Else
                Return "Null"
            End If

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
            Return ""
        End Try

    End Function

    Public Sub SetCustomPropertyFormula( _
        ByVal customPropertyShape As Visio.Shape, _
        ByVal rowNameU As String, _
        ByVal universalSyntaxFormula As String)

        Const CUST_PROP_PREFIX As String = "Prop."
        Dim customPropertyCell As Microsoft.Office.Interop.Visio.Cell

        Dim visioApplication As Microsoft.Office.Interop.Visio.Application
        visioApplication = CType(customPropertyShape.Application,  _
            Microsoft.Office.Interop.Visio.Application)

        Try

            ' Verify that all incoming string parameters are not of zero 
            ' length, except for the ones that have default values as ""
            ' and the output parameters.
            If (rowNameU.Length() = 0) Then

                Throw New System.ArgumentNullException("rowNameU", _
                    "Zero length string input.")
            End If

            If (universalSyntaxFormula.Length() = 0) Then

                Throw New System.ArgumentNullException( _
                    "universalSyntaxFormula", "Zero length string input.")
            End If

            ' See if the shape has a custom property Value cell with the
            ' universal row name. If no cell exists, display an error
            ' message and exit this procedure.
            If Not CBool(customPropertyShape.CellExistsU( _
                CUST_PROP_PREFIX & rowNameU, CShort(False))) Then

                If visioApplication.AlertResponse = 0 Then

                    MsgBox("This shape " _
                        & "does not have a custom property " & vbCrLf & _
                        "with the universal name '" & vbCrLf & rowNameU & _
                        "'.")

                    Return

                End If

            End If

            ' Get the Cell object. Note the addition of "Prop." to the name
            ' given to the cell.
            customPropertyCell = customPropertyShape.CellsU( _
                CUST_PROP_PREFIX & rowNameU)

            ' change when the width of the shape changes.
            customPropertyCell.FormulaU = universalSyntaxFormula

        Catch Err As Exception
            System.Diagnostics.Debug.WriteLine(Err.Message)
        End Try

    End Sub

    Public Sub SetCustomPropertyValue( _
        ByVal customPropertyShape As Microsoft.Office.Interop.Visio.Shape, _
        ByVal rowNameU As String, _
        ByVal propertyValue As Object, _
        ByVal units As Microsoft.Office.Interop.Visio.VisUnitCodes)

        Const CUST_PROP_PREFIX As String = "Prop."

        Dim customPropertyCell As Microsoft.Office.Interop.Visio.Cell

        Dim visioApplication As Microsoft.Office.Interop.Visio.Application

        visioApplication = CType(customPropertyShape.Application,  _
            Microsoft.Office.Interop.Visio.Application)

        Try

            ' Verify that all incoming string parameters are not of zero 
            ' length, except for the ones that have default values as ""
            ' and the output parameters.
            If (rowNameU.Length() = 0) Then

                Throw New System.ArgumentNullException("rowNameU", _
                    "Zero length string input.")
            End If

            ' See if the shape has a custom property Value cell with the
            ' universal row name. If no cell exists, display an error 
            ' message and exit this procedure.
            If Not CBool(customPropertyShape.CellExistsU(CUST_PROP_PREFIX _
                & rowNameU, CShort(False))) Then

                If visioApplication.AlertResponse = 0 Then

                    System.Windows.Forms.MessageBox.Show( _
                        "This shape does not have a custom property " _
                        & vbCrLf & "with the universal name '" _
                        & rowNameU & "'.")
                End If

                Return

            End If

            ' Get the Cell object. Note the addition of "Prop."
            ' to the name given to the cell.
            customPropertyCell = customPropertyShape.CellsU( _
                CUST_PROP_PREFIX & rowNameU)

            If (units = Microsoft.Office.Interop.Visio. _
                VisUnitCodes.visUnitsString) Then

                SetCellValueToString(customPropertyCell, _
                    CStr(propertyValue))

            Else

                ' Use Result property to set values other than String type.
                customPropertyCell.Result(units) = CDbl(propertyValue)
            End If

        Catch err As Exception
            System.Diagnostics.Debug.WriteLine(err.Message)
        End Try

    End Sub




    '********* visio snippet vb.net vis0006vb ******************

    Public Sub SetCellValueToString _
            (ByVal vsoCell As Microsoft.Office.Interop.Visio.Cell, _
            ByVal strNewValue As String)


        Try
            ' Set the value for the cell.
            vsoCell.FormulaU = StringToFormulaForString(strNewValue)

        Catch com As COMException
            ' add com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            ' add exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try


    End Sub





    '********* visio snippet vb.net vis0002vb ******************

    Public Function FormulaStringToString(ByVal formula As String) _
As String

        Const OneQuote As String = """"
        Const TwoQuotes As String = """"""

        Dim convertedFormula As String = ""

        Try

            'Initialize the converted formula from the value passed in.
            convertedFormula = formula

            ' Check if this Formula[U] value is a quoted string.
            ' If it is, remove extra quote characters.
            If (convertedFormula.StartsWith(OneQuote) And _
                convertedFormula.EndsWith(OneQuote)) Then

                ' Remove the wrapping quote characters as well as any
                ' extra quote marks in the body of the string.
                convertedFormula = convertedFormula.Substring(1, _
                    (convertedFormula.Length - 2))
                convertedFormula = convertedFormula.Replace(TwoQuotes, _
                    OneQuote)
            End If

        Catch ex As Exception

            'Return a empty string if error occurs.
            convertedFormula = ""
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return convertedFormula

    End Function





    Public Function MapDrawingToScreen _
        (ByVal referenceWindow As  _
        Microsoft.Office.Interop.Visio.Window, _
        ByVal drawingX As Double, _
        ByVal drawingY As Double) _
        As System.Drawing.Point

        Dim drawingLeft As Double
        Dim drawingTop As Double
        Dim drawingWidth As Double
        Dim drawingHeight As Double
        Dim screenLeft As Integer
        Dim screenTop As Integer
        Dim screenWidth As Integer
        Dim screenHeight As Integer
        Dim screenX As Short = 0
        Dim screenY As Short = 0

        Try

            ' Get the window coordinates in Visio units.
            referenceWindow.GetViewRect(drawingLeft, drawingTop, _
                drawingWidth, drawingHeight)

            ' Get the window coordinates in pixels.
            referenceWindow.GetWindowRect(screenLeft, screenTop, _
                screenWidth, screenHeight)

            ' Convert the X coordinate by using pixels per inch from the
            ' width values.
            screenX = CShort(screenLeft + _
                ((screenWidth / drawingWidth) * (drawingX - drawingLeft)))

            ' Convert the Y coordinate by using pixels per inch from the
            ' height values and using a top-left origin (Windows
            ' coordinates) instead of a bottom-left origin (Visio
            ' coordinates).
            screenY = CShort((screenTop + _
                (screenHeight / drawingHeight) * (drawingTop - drawingY)))

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Global Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        MapDrawingToScreen = New System.Drawing.Point(screenX, screenY)

    End Function

#End Region

#Region " Work with objects  "


    '*********************************************************************
    '*********************************************************************
    '
    '               Text Field
    '
    '*********************************************************************
    '*********************************************************************


    '********* visio snippet vb.net vis0087vb ******************
    Public Function AddTextFieldToShape _
                    (ByVal visShape As Microsoft.Office.Interop.Visio.Shape, _
                    ByVal strFieldPrompt As String, _
                    ByVal strProperty As String, _
                    ByVal fldFormat As Microsoft.Office.Interop.Visio.VisFieldFormats) _
                    As Boolean


        Dim visText As Microsoft.Office.Interop.Visio.Characters
        Dim blnResult As Boolean = False

        Try



            visText = visShape.Characters
            visText.Text = strFieldPrompt

            ' Set the character color of the text to blue.
            visText.CharProps(CShort(VisCellIndices.visCharacterColor)) = CShort(VisDefaultColors.visBlue)

            ' Set the font size of the text to 9.
            visText.CharProps(CShort(VisCellIndices.visCharacterSize)) = 9

            ' Start a new run that will contain the appended string with
            ' different formatting.
            visText.Begin = visText.End

            ' Add the field
            visText.AddCustomField(strProperty, fldFormat)

            ' Keep the same formatting as set for the previous string, 
            ' except set the character style to bold italic.
            visText.CharProps(CShort(VisCellIndices.visCharacterStyle)) = _
                CShort(VisCellVals.visBold) + _
                CShort(VisCellVals.visItalic)
            ' Set the character color
            visText.CharProps(CShort(VisCellIndices.visCharacterColor)) = CShort(VisDefaultColors.visBlack)

            blnResult = True


        Catch com As COMException
            ' insert com exception handler here

            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return blnResult

    End Function




    '*********************************************************************
    '*********************************************************************
    '
    '               Action Fields
    '
    '*********************************************************************
    '*********************************************************************

    '// <summary>This procedure adds a right mouse action to a shape. 
    '// The right mouse action is added to the Actions section of the 
    '// given shape.</summary>
    '// <param name="targetShapet">Shape to add action menu to.</param>
    '// <param name="menuCaption">Caption for the newly created menu item.
    '// </param>
    '// <param name="menuAction">Action to be taken when the menu item
    '// is selected. This is a formula with universal syntax. </param>
    '// <param name="menuEnabled">Initial enabled state of the menu item.
    '// </param>
    '// <param name="menuChecked">Initial checked state of the menu item.
    '// </param>
    '// <param name="menuBeginGroup">Display a divider bar above the 
    '// command in the menu.
    '// </param>
    '// <param name="menuAddToBottom">Display the command at the bottom 
    '// of the menu. </param>

    Public Sub AddRightMouseAction( _
        ByVal targetShape As Microsoft.Office.Interop.Visio.Shape, _
        ByVal menuCaption As String, _
        ByVal menuAction As String, _
        ByVal menuEnabled As Boolean, _
        ByVal menuChecked As Boolean, _
        ByVal beginGroup As Boolean, _
        ByVal addToBottom As Boolean)

        Dim actionRow As Integer
        Dim actionRows As Integer
        Dim taggedMenuCaption As String
        Dim rowCaption As String
        Dim cleanMenuCaption As String
        Dim actionCell As Microsoft.Office.Interop.Visio.Cell
        Dim actionExists As Boolean

        Try

            ' The menuCaption string may need to be modified to include a tag
            ' that indicates the menu should be at the bottom, or should
            ' be preceded by a separator line.
            taggedMenuCaption = menuCaption

            ' strip modifier tokens from the caption
            cleanMenuCaption = menuCaption.Replace(AcceleratorPrefix, "")

            ' Check if the right menu action item already exists.
            actionRows = targetShape.RowCount( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                visSectionAction))

            actionExists = False

            For actionRow = 0 To actionRows - 1

                actionCell = targetShape.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisSectionIndices.visSectionAction), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisRowIndices.visRowAction + actionRow), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisCellIndices.visActionMenu))

                rowCaption = FormulaStringToString(actionCell.FormulaU)

                ' strip modifier tokens from the caption before compare
                rowCaption = rowCaption.Replace(DividerBarPrefix, "")
                rowCaption = rowCaption.Replace(AddToBottomPrefix, "")
                rowCaption = rowCaption.Replace(AcceleratorPrefix, "")

                If (rowCaption = cleanMenuCaption) Then

                    ' The right menu action item already exists;
                    actionExists = True
                    Exit For
                End If
            Next

            If (actionExists = False) Then

                ' prefix underscore (_) to the caption to add a separator 
                ' line above it.
                If (beginGroup = True) Then
                    taggedMenuCaption = _
                        taggedMenuCaption.Insert(0, DividerBarPrefix)
                End If

                ' prefix percent (%) to the caption to add it to the bottom 
                ' of the menu.
                If (addToBottom = True) Then
                    taggedMenuCaption = _
                        taggedMenuCaption.Insert(0, AddToBottomPrefix)
                End If

                ' Add a new action row to the shape.
                actionRow = targetShape.AddRow( _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisSectionIndices.visSectionAction), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisRowIndices.visRowLast), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisRowIndices.visRowAction))

                ' Set the menu caption.
                actionCell = targetShape.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisSectionIndices.visSectionAction), _
                    CShort(actionRow), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisCellIndices.visActionMenu))
                actionCell.FormulaU = _
                    StringToFormulaForString( _
                    taggedMenuCaption)

                ' Set the action for the menu item.
                actionCell = targetShape.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisSectionIndices.visSectionAction), _
                    CShort(actionRow), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisCellIndices.visActionAction))
                actionCell.FormulaU = menuAction

                ' Set the menu item's enabled/disabled state.
                actionCell = targetShape.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisSectionIndices.visSectionAction), _
                    CShort(actionRow), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisCellIndices.visActionDisabled))
                actionCell.ResultFromInt(Microsoft.Office.Interop. _
                    Visio.VisUnitCodes.visNumber) = _
                Convert.ToInt32(Not (menuEnabled), _
                System.Globalization.CultureInfo.InvariantCulture)

                ' Set the menu item's checked state.
                actionCell = targetShape.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisSectionIndices.visSectionAction), _
                    CShort(actionRow), _
                    CShort(Microsoft.Office.Interop.Visio. _
                    VisCellIndices.visActionChecked))
                actionCell.ResultFromInt(Microsoft.Office.Interop. _
                    Visio.VisUnitCodes.visNumber) = _
                Convert.ToInt32(menuChecked, _
                System.Globalization.CultureInfo.InvariantCulture)

            End If
        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    '*********************************************************************
    '*********************************************************************
    '
    '               Hyperlink
    '
    '*********************************************************************
    '*********************************************************************

    '********* visio snippet vb.net vis0084vb ******************
    Public Function AddHyperLinkToShape _
                (ByVal visShape As Microsoft.Office.Interop.Visio.Shape, _
                ByVal strLocalRowName As String, _
                ByVal strRowNameU As String, _
                ByVal strDescription As String, _
                ByVal strAddress As String, _
                ByVal strSubAddress As String, _
                ByVal strFrame As String, _
                ByVal blnNewWin As Boolean, _
                ByVal blnDefault As Boolean) _
                As Boolean

        Dim vsoCell As Microsoft.Office.Interop.Visio.Cell
        Dim intRowIndex As Integer

        Dim blnReturn As Boolean = False


        If visShape.SectionExists(VisSectionIndices.visSectionHyperlink, False) = False Then
            visShape.AddSection(VisSectionIndices.visSectionHyperlink)
        End If

        Try
            intRowIndex = visShape.AddNamedRow(VisSectionIndices.visSectionHyperlink, _
                 strLocalRowName, _
                 VisRowIndices.visRow1stHyperlink)



            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionHyperlink, _
                VisRowIndices.visRow1stHyperlink + intRowIndex, VisCellIndices.visHLinkDescription)
            If strDescription = Nothing Then
                SetCellValueToString(vsoCell, "")
            Else
                SetCellValueToString(vsoCell, strDescription)
            End If


            If strRowNameU = Nothing Then strRowNameU = ""
            If (strLocalRowName <> strRowNameU And _
                Len(strRowNameU) > 0) Then
                vsoCell.RowNameU = strRowNameU
            End If

            ' Column 2: Address
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionHyperlink, _
                VisRowIndices.visRow1stHyperlink + intRowIndex, VisCellIndices.visHLinkAddress)
            If strAddress = Nothing Then
                SetCellValueToString(vsoCell, "")
            Else
                SetCellValueToString(vsoCell, strAddress)
            End If

            ' Column 3: SubAddress
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionHyperlink, _
                VisRowIndices.visRow1stHyperlink + intRowIndex, VisCellIndices.visHLinkSubAddress)
            If strSubAddress = Nothing Then
                SetCellValueToString(vsoCell, "")
            Else
                SetCellValueToString(vsoCell, strSubAddress)
            End If

            ' Column 4: frame
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionHyperlink, _
                VisRowIndices.visRow1stHyperlink + intRowIndex, VisCellIndices.visHLinkExtraInfo)
            If strFrame = Nothing Then
                SetCellValueToString(vsoCell, "")
            Else
                SetCellValueToString(vsoCell, strFrame)
            End If

            ' Column 5: new window
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionHyperlink, _
                VisRowIndices.visRow1stHyperlink + intRowIndex, VisCellIndices.visHLinkNewWin)
            If blnNewWin = Nothing Then
                SetCellValueToString(vsoCell, CStr(False))
            Else
                SetCellValueToString(vsoCell, CStr(blnNewWin))
            End If
            ' Column 6: default
            vsoCell = visShape.CellsSRC(VisSectionIndices.visSectionHyperlink, _
                VisRowIndices.visRow1stHyperlink + intRowIndex, VisCellIndices.visHLinkDefault)
            If blnDefault = Nothing Then
                SetCellValueToString(vsoCell, CStr(False))
            Else
                SetCellValueToString(vsoCell, CStr(blnDefault))
            End If

            blnReturn = True

        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try


        Return blnReturn

    End Function




    '*********************************************************************
    '*********************************************************************
    '
    '               User property
    '
    '*********************************************************************
    '*********************************************************************

    '
    ' this alters the masters in the document to support the use of
    ' data graphics 
    '

    '********* visio snippet vb.net vis0115vb ******************
    Public Sub addDataGraphicUserFieldsToMasters _
        (ByVal visDoc As Visio.Document, _
         Optional ByVal intValueFont As String = "6 pt", _
         Optional ByVal intLabelFont As String = "6 pt", _
         Optional ByVal dblCalloutWidth As String = "10 in")


        Try

            Dim cpyMaster As Visio.Master
            Dim mstShape As Visio.Shape
            Dim lclMasters As Visio.Masters = visDoc.Masters
            Dim intMasterCt As Integer = visDoc.Masters.Count

            For Each lclMaster In lclMasters
                ' make a copy of the master
                cpyMaster = Nothing
                cpyMaster = lclMaster.Open
                mstShape = cpyMaster.Shapes(1)

                ' add support for data graphics to the components
                AddUserPropertyToShape(mstShape, "visDGDisplayFormat", "visDGDisplayFormat", "visDGDisplayFormat", "", "")
                AddUserPropertyToShape(mstShape, "visDGDefaultPos", "visDGDefaultPos", "visDGDefaultPos", "", "")
                AddUserPropertyToShape(mstShape, "visDGCBVFill", "visDGCBVFill", "visDGCBVFill", "", "")
                AddUserPropertyToShape(mstShape, "visDGOldColors", "visDGOldColors", "visDGOldColors", "", "")
                AddUserPropertyToShape(mstShape, "msvThemeColors", "msvThemeColors", "msvThemeColors", "", "")
                AddUserPropertyToShape(mstShape, "msvThemeEffects", "msvThemeEffects", "msvThemeEffects", "", "")

                ' add user fields to pass in the shape parameters from the database
                AddUserPropertyToShape(mstShape, "dbIntValueFont", "dbIntValueFont", "dbIntValueFont", CStr(intValueFont), "")
                AddUserPropertyToShape(mstShape, "dbIntLabelFont", "dbIntLabelFont", "dbIntLabelFont", CStr(intLabelFont), "")
                AddUserPropertyToShape(mstShape, "dbDblCallout", "dbDblCallout", "dbDblCall", CStr(dblCalloutWidth), "")

                ' put it back
                cpyMaster.Close()

            Next lclMaster

            cpyMaster = Nothing


        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try


    End Sub

    '
    '
    '
    '********* visio snippet vb.net vis0116vb ******************
    Public Sub addDataGraphicUserFieldsToShape _
            (ByVal visShape As Visio.Shape, _
            Optional ByVal intValueFont As String = "6 pt", _
            Optional ByVal intLabelFont As String = "6 pt", _
            Optional ByVal dblCalloutWidth As String = "10 in")



        Try


            ' add support for data graphics to the components
            AddUserPropertyToShape(visShape, "visDGDisplayFormat", "visDGDisplayFormat", "visDGDisplayFormat", "", "")
            AddUserPropertyToShape(visShape, "visDGDefaultPos", "visDGDefaultPos", "visDGDefaultPos", "", "")
            AddUserPropertyToShape(visShape, "visDGCBVFill", "visDGCBVFill", "visDGCBVFill", "", "")
            AddUserPropertyToShape(visShape, "visDGOldColors", "visDGOldColors", "visDGOldColors", "", "")
            AddUserPropertyToShape(visShape, "msvThemeColors", "msvThemeColors", "msvThemeColors", "", "")
            AddUserPropertyToShape(visShape, "msvThemeEffects", "msvThemeEffects", "msvThemeEffects", "", "")

            ' add user fields to pass in the shape parameters from the database
            AddUserPropertyToShape(visShape, "dbIntValueFont", "dbIntValueFont", "dbIntValueFont", CStr(intValueFont), "")
            AddUserPropertyToShape(visShape, "dbIntLabelFont", "dbIntLabelFont", "dbIntLabelFont", CStr(intLabelFont), "")
            AddUserPropertyToShape(visShape, "dbDblCallout", "dbDblCallout", "dbDblCallout", CStr(dblCalloutWidth), "")



        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try


    End Sub


    '
    ' some of the shapes that are used are groups of groups, so the need
    ' is to change not only the top level shape but those that are grouped
    ' inside as well
    '

    '********* visio snippet vb.net vis0003vb ******************
    Public Sub recurseApplyCellFormula _
    (ByVal visShape As Visio.Shape, _
    ByVal intSection As Integer, _
    ByVal intRow As Integer, _
    ByVal intCell As Integer, _
    ByVal strFormula As String)

        Try


            setCellFormula(visShape, intSection, intRow, intCell, strFormula)

            ' if embedded shapes exist, recurse through them also
            Dim visEmbShape As shape
            visEmbShape = Nothing
            If visShape.Type = VisShapeTypes.visTypeGroup Then
                For Each visEmbShape In visShape.Shapes
                    recurseApplyCellFormula(visEmbShape, intSection, intRow, intCell, strFormula)
                Next visEmbShape
            End If

        Catch com As COMException
            If com.ErrorCode = -2032466648 Then
                ' do nothing 
            Else
                '********* visio snippet vb.net vis0056vb ******************
                Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
                If (rethrow) Then
                    Throw
                End If
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

    End Sub



    '********* visio snippet vb.net vis0004vb ******************
    Public Sub recurseApplyCustomFormula _
        (ByVal visShape As Visio.Shape, _
        ByVal strProperty As String, _
        ByVal strFormula As String)

        Try

            Dim visCell As Visio.Cell
            Dim visEmbShape As Visio.Shape = Nothing


            If visShape.CellExists(strProperty, False) = True Then
                visCell = visShape.Cells(strProperty)
                visCell.FormulaU = strFormula
            Else
                ' if embedded shapes exist, recurse through them also
                If visShape.Type = VisShapeTypes.visTypeGroup Then
                    For Each visEmbShape In visShape.Shapes
                        recurseApplyCustomFormula(visEmbShape, strProperty, strFormula)
                    Next visEmbShape
                End If

            End If

            ' if embedded shapes exist, recurse through them also
            If visShape.Type = VisShapeTypes.visTypeGroup Then
                For Each visEmbShape In visShape.Shapes
                    recurseApplyCustomFormula(visEmbShape, strProperty, strFormula)
                Next visEmbShape
            End If


        Catch com As COMException
            If com.ErrorCode = -2032466648 Then
                ' do nothing 
            Else
                '********* visio snippet vb.net vis0056vb ******************
                Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
                If (rethrow) Then
                    Throw
                End If
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub


    '********* visio snippet vb.net vis0005vb ******************
    Private Sub setCellFormula _
        (ByVal shp As Microsoft.Office.Interop.Visio.Shape, _
        ByVal iSect As Integer, _
        ByVal iRow As Integer, _
        ByVal iCell As Integer, _
        ByVal formula As String)

        Try


            ' test to make sure cell exists first (aee)
            If shp.CellsSRCExists(iSect, iRow, iCell, False) = True Then
                'Transfer cell formula if different
                If Not shp.CellsSRC(iSect, iRow, iCell).FormulaU = formula Then
                    shp.CellsSRC(iSect, iRow, iCell).FormulaForceU = formula
                End If
            End If

        Catch com As COMException
            ' add com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' add exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try


    End Sub






    '*********************************************************************
    '*********************************************************************
    '
    '               Custom properties
    '
    '*********************************************************************
    '*********************************************************************






    '********* visio snippet vb.net vis0078vb ******************

    Public Sub deleteMasterShapeData _
            (ByVal visApp As Microsoft.Office.Interop.Visio.Application)


        Dim visDoc As Microsoft.Office.Interop.Visio.Document

        Dim lclMaster As Master = Nothing
        Dim cpyMaster As Master = Nothing
        Dim mstShape As Shape = Nothing

        Dim intX As Integer
        Dim intCt As Integer


        Try

            If visApp Is Nothing Then Exit Sub

            visDoc = visApp.ActiveDocument

            Dim intMasterCt As Integer = visDoc.Masters.Count

            Dim lclMasters As Masters = visDoc.Masters

            For Each lclMaster In lclMasters
                ' make a copy of the master
                cpyMaster = Nothing
                cpyMaster = lclMaster.Open
                mstShape = cpyMaster.Shapes(1)
                intX = -1
                intCt = -1
                If mstShape.SectionExists(VisSectionIndices.visSectionProp, False) = True Then
                    intCt = mstShape.RowCount(VisSectionIndices.visSectionProp)
                    For intX = intCt To 0 Step -1
                        If mstShape.CellsSRCExists(VisSectionIndices.visSectionProp, intX, VisCellIndices.visCustPropsType, VisExistsFlags.visExistsAnywhere) = True Then
                            mstShape.DeleteRow(VisSectionIndices.visSectionProp, intX)
                        End If
                    Next intX
                End If
                ' put it back
                cpyMaster.Close()
            Next lclMaster


        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        cpyMaster = Nothing
        lclMaster = Nothing

    End Sub






    '
    ' delete a specific shapes data properties
    '
    '********* visio snippet vb.net vis0079vb ******************

    Public Sub deleteShapeData(ByRef visShape As Visio.Shape)

        Dim intX As Integer
        Dim intCt As Integer

        Try

            If visShape.SectionExists(VisSectionIndices.visSectionProp, False) = True Then
                intCt = visShape.RowCount(VisSectionIndices.visSectionProp)
                For intX = intCt To 0 Step -1
                    If visShape.CellsSRCExists(VisSectionIndices.visSectionProp, intX, VisCellIndices.visCustPropsType, VisExistsFlags.visExistsAnywhere) = True Then
                        visShape.DeleteRow(VisSectionIndices.visSectionProp, intX)
                    End If
                Next intX
            End If

        Catch com As COMException
            ' add com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' add exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

    End Sub




    '********* visio snippet vb.net vis0077vb ******************
    ' 3, "", "", True, False, "sort"

    Function AddCustomProperty( _
        ByVal addedToShape As Microsoft.Office.Interop.Visio.Shape, _
        ByVal localRowName As String, _
        ByVal rowNameU As String, _
        ByVal labelName As String, _
        ByVal propType As Microsoft.Office.Interop.Visio.VisCellVals, _
        ByVal format As String, _
        ByVal prompt As String, _
        ByVal askOnDrop As Boolean, _
        ByVal hidden As Boolean, _
        ByVal sortKey As String) _
        As Boolean

        Const CUST_PROP_PREFIX As String = "Prop."

        Dim shapeCell As Microsoft.Office.Interop.Visio.Cell
        Dim rowIndex As Short
        Dim returnValue As Boolean

        Try

            ' Add a named custom property row. In addition to adding a row 
            ' with the local name, specified via localRowName parameter, 
            ' this call will usually set the universal name of the new row 
            ' to localRowName as well. However, the universal row name will
            ' not be set if this shape already has a custom property row  
            ' that has the universal name equal to localRowName.
            rowIndex = addedToShape.AddNamedRow( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), localRowName, _
                CShort(Microsoft.Office.Interop.Visio.VisRowIndices. _
                    visRowProp))

            ' The columns of the properties to set are fixed and can be
            ' accessed directly using CellsSRC and column index.

            ' Get the Cell object for each one of the items in the
            ' custom property and set its value using the FormulaU property
            ' of the Cell object.

            ' Column 1 : Prompt
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsPrompt))

            If prompt = Nothing Then
                SetCellValueToString(shapeCell, "")
            Else
                SetCellValueToString(shapeCell, prompt)
            End If
            ' Any cell in the row can be used to set the universal row name.
            ' Only set the name if rowNameU parameter differs from the
            ' local name and is not blank.
            If ((localRowName <> rowNameU) And (Len(rowNameU) > 0)) Then
                shapeCell.RowNameU = rowNameU
            End If

            ' Column 2 : Label
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                  visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsLabel))
            SetCellValueToString(shapeCell, _
                labelName)

            ' Column 3 : Format
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsFormat))
            If format = Nothing Then
                SetCellValueToString(shapeCell, "")
            Else
                SetCellValueToString(shapeCell, format)
            End If

            ' Column 4 : SortKey
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsSortKey))

            If sortKey = Nothing Then
                SetCellValueToString(shapeCell, "sort")
            Else
                SetCellValueToString(shapeCell, sortKey)
            End If

            ' Column 5 : Type
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsType))
            If propType = Nothing Then
                SetCellValueToString(shapeCell, CStr(Microsoft.Office.Interop.Visio.VisCellVals.visStandard))
            Else
                SetCellValueToString(shapeCell, CStr(propType))
            End If


            ' Column 6 : Hidden (This corresponds to the "Hidden" check box
            ' in the UI)
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsInvis))
            If hidden = Nothing Then
                SetCellValueToString(shapeCell, CStr(False))
            Else
                SetCellValueToString(shapeCell, hidden.ToString)
            End If


            ' Column 7 : Ask
            shapeCell = addedToShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio.VisSectionIndices. _
                    visSectionProp), rowIndex, _
                CShort(Microsoft.Office.Interop.Visio.VisCellIndices. _
                    visCustPropsAsk))
            If askOnDrop = Nothing Then
                SetCellValueToString(shapeCell, CStr(True))
            Else
                SetCellValueToString(shapeCell, askOnDrop.ToString)
            End If

            ' Set the Custom property for the shape using the FormulaU
            ' property of the cell.
            shapeCell = addedToShape.CellsU(CUST_PROP_PREFIX & rowNameU)
            SetCellValueToString(shapeCell, _
                rowNameU)

            returnValue = True

        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return returnValue

    End Function








    '*********************************************************************
    '*********************************************************************
    '
    '               Layer to Page
    '
    '*********************************************************************
    '*********************************************************************

    '
    '
    '
    Public Sub AddLayerToPage( _
        ByVal thePage As Microsoft.Office.Interop.Visio.Page, _
        ByVal name As String, _
        Optional ByVal nameU As String = "", _
        Optional ByVal print As Boolean = True, _
        Optional ByVal snap As Boolean = True, _
        Optional ByVal glue As Boolean = True, _
        Optional ByVal lockLayer As Boolean = False, _
        Optional ByVal colorFormulaU As String = "")

        Dim addedLayer As Microsoft.Office.Interop.Visio.Layer
        Dim layerCell As Microsoft.Office.Interop.Visio.Cell

        Try


            If (thePage Is Nothing) Then
                Throw New System.ArgumentNullException("thePage", _
                    "Page is Null.")
            End If

            ' Verify that all incoming string parameters are not of zero 
            ' length, except for the ones that have default values as "".
            If (name.Length() = 0) Then
                Throw New System.ArgumentNullException("name", _
                    "Zero length string input.")
            End If

            ' Get the Layers collection and add a layer with the name
            ' specified by parameter name.
            addedLayer = thePage.Layers.Add(name)

            ' Set the universal name for this layer, if the parameter nameU
            ' is not blank.
            If (Len(nameU) > 0) Then

                addedLayer.NameU = nameU

            End If

            ' Set the value for the Print cell of the layer.
            layerCell = addedLayer.CellsC(CShort(Microsoft.Office. _
                Interop.Visio.VisCellIndices.visLayerPrint))
            layerCell.ResultIU = CDbl(print)

            ' Set the value for the Snap cell of the layer.
            layerCell = addedLayer.CellsC(CShort(Microsoft.Office. _
                Interop.Visio.VisCellIndices.visLayerSnap))
            layerCell.ResultIU = CDbl(snap)

            ' Set the value for the Glue cell of the layer.
            layerCell = addedLayer.CellsC(CShort(Microsoft.Office. _
                Interop.Visio.VisCellIndices.visLayerGlue))
            layerCell.ResultIU = CDbl(glue)

            ' Set the value for the Lock cell of the layer.
            layerCell = addedLayer.CellsC(CShort(Microsoft.Office. _
                Interop.Visio.VisCellIndices.visLayerLock))
            layerCell.ResultIU = CDbl(lockLayer)

            ' Set the color of the layer, if the parameter colorFormulaU
            ' is not blank.
            If (Len(colorFormulaU)) > 0 Then

                ' Get the Color cell of the layer and set the universal
                ' formula.
                layerCell = addedLayer.CellsC(CShort(Microsoft.Office. _
                    Interop.Visio.VisCellIndices.visLayerColor))
                layerCell.FormulaU = colorFormulaU

            End If

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    '*********************************************************************
    '*********************************************************************
    '
    '           Add and Remove Shape From Layer
    '
    '*********************************************************************
    '*********************************************************************

    '
    '
    '
    Public Sub RemoveShapeFromLayer _
                    (ByVal visPage As Visio.Page, _
                    ByVal visShape As Visio.Shape, _
                    ByVal strLayer As String, _
                    ByVal shortPreserve As Short)


        Try

            Dim existingLayers As Visio.Layers = Nothing
            Dim removedLayer As Visio.Layer = Nothing
            Dim currentLayer As Visio.Layer = Nothing
            ' get a list of the layers on the page
            existingLayers = visPage.Layers

            Try
                removedLayer = existingLayers.ItemU(strLayer)
            Catch
            End Try
            ' if the layer is on the page then go check the shape
            If removedLayer IsNot Nothing Then
                Dim intLayer As Int16
                For intLayer = 1 To visShape.LayerCount
                    currentLayer = visShape.Layer(intLayer)
                    If currentLayer.NameU = strLayer Then
                        removedLayer.Remove(visShape, shortPreserve)
                        Exit For
                    End If
                Next intLayer
            End If

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try


    End Sub

    '
    '
    '
    Public Sub addShapeToLayer _
                    (ByVal visPage As Visio.Page, _
                    ByVal visShape As Visio.Shape, _
                    ByVal strLayer As String, _
                    ByVal shortPreserve As Short, _
                    Optional ByVal blnAddLayer As Boolean = True)

        Try

            Dim existingLayers As Visio.Layers
            Dim addedLayer As Visio.Layer = Nothing


            ' get a list of the layers on the page
            existingLayers = visPage.Layers

            Try
                addedLayer = existingLayers.ItemU(strLayer)
            Catch
            End Try
            If blnAddLayer = True Then
                ' if the layer isn't there, then add it
                If addedLayer Is Nothing Then
                    'add to page
                    AddLayerToPage(visPage, strLayer)
                    ' recall the layers
                    existingLayers = visPage.Layers
                    'reassign it
                    addedLayer = existingLayers.ItemU(strLayer)
                End If
            End If

            addedLayer.Add(visShape, shortPreserve)

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    '*********************************************************************
    '*********************************************************************
    '
    '               Connection Points
    '
    '*********************************************************************
    '*********************************************************************

    '********* visio snippet vb.net vis0008vb ******************
    Public Function AddConnectionPointToShape _
                    (ByVal vsoShape As Microsoft.Office.Interop.Visio.Shape, _
                    ByVal strLocalRowName As String, _
                    ByVal strRowNameU As String, _
                    ByVal strLabelName As String, _
                    ByVal strConnectType As String, _
                    ByVal strX As String, _
                    ByVal strY As String, _
                    ByVal strDirX As String, _
                    ByVal strDirY As String, _
                    ByVal blnAutoGen As Boolean) _
                    As Boolean

        Dim vsoCell As Microsoft.Office.Interop.Visio.Cell
        Dim intRowIndex As Integer

        Dim blnReturn As Boolean = False

        Try
            If vsoShape.SectionExists(VisSectionIndices.visSectionConnectionPts, False) = False Then
                vsoShape.AddSection(VisSectionIndices.visSectionConnectionPts)
            End If

            intRowIndex = vsoShape.AddNamedRow(VisSectionIndices.visSectionConnectionPts, _
                 strLocalRowName, _
                 VisRowIndices.visRowConnectionPts)

            ' Column 0: X
            vsoCell = vsoShape.CellsSRC(VisSectionIndices.visSectionConnectionPts, _
                VisRowIndices.visRowConnectionPts + intRowIndex, VisCellIndices.visX)
            vsoCell.Formula = strX

            If (strLocalRowName <> strRowNameU And _
                Len(strRowNameU) > 0) Then
                vsoCell.RowNameU = strRowNameU
            End If

            ' Column 1: Y
            vsoCell = vsoShape.CellsSRC(VisSectionIndices.visSectionConnectionPts, _
                VisRowIndices.visRowConnectionPts + intRowIndex, VisCellIndices.visY)
            vsoCell.Formula = strY

            ' Column 2: direction x
            vsoCell = vsoShape.CellsSRC(VisSectionIndices.visSectionConnectionPts, _
                VisRowIndices.visRowConnectionPts + intRowIndex, VisCellIndices.visCnnctDirX)
            If strDirX = Nothing Then
                strDirX = ""
            End If
            vsoCell.Formula = strDirX

            ' Column 3: direction y
            vsoCell = vsoShape.CellsSRC(VisSectionIndices.visSectionConnectionPts, _
                VisRowIndices.visRowConnectionPts + intRowIndex, VisCellIndices.visCnnctDirY)
            If strDirY = Nothing Then
                strDirY = ""
            End If
            vsoCell.Formula = strDirY

            ' Column 4: type
            vsoCell = vsoShape.CellsSRC(VisSectionIndices.visSectionConnectionPts, _
                VisRowIndices.visRowConnectionPts + intRowIndex, VisCellIndices.visCnnctType)
            vsoCell.Formula = strConnectType

            ' Column 5: autogen
            vsoCell = vsoShape.CellsSRC(VisSectionIndices.visSectionConnectionPts, _
                VisRowIndices.visRowConnectionPts + intRowIndex, VisCellIndices.visCnnctAutoGen)
            If blnAutoGen = Nothing Then
                blnAutoGen = False
            End If
            vsoCell.ResultIU = blnAutoGen

            blnReturn = True

        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return blnReturn

    End Function





    '*********************************************************************
    '*********************************************************************
    '
    '       Standard Connections (left, right, top, bottom, center)
    '
    '*********************************************************************
    '*********************************************************************


    '********* visio snippet vb.net vis0009vb ******************

    Public Sub AddStandardConnections _
        (ByVal visShape As Microsoft.Office.Interop.Visio.Shape)

        Try

            Dim visSection As Integer
            Dim blnResult As Boolean

            visSection = VisSectionIndices.visSectionConnectionPts
            ' check to make sure the section exists first
            If visShape.SectionExists(visSection, False) = False Then
                visShape.AddSection(visSection)
            End If


            blnResult = AddConnectionPointToShape(visShape, "center", "center", "center", _
                    2, "Width * 0.5", "Height * 0.5", 0, 0, False)

            blnResult = AddConnectionPointToShape(visShape, "left", "left", "left", _
                    2, "0", "Height * 0.5", 0, 0, False)

            blnResult = AddConnectionPointToShape(visShape, "right", "right", "right", _
                    2, "Width", "Height * 0.5", 0, 0, False)

            blnResult = AddConnectionPointToShape(visShape, "top", "top", "top", _
                    2, "Width * 0.5", "Height", 0, 0, False)

            blnResult = AddConnectionPointToShape(visShape, "bottom", "bottom", "bottom", _
                    2, "Width * 0.5", "0", 0, 0, False)


        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If


        End Try

    End Sub




    Public Function DropMasterOnPage( _
      ByVal pageToDrop As Microsoft.Office.Interop.Visio.Page, _
      ByVal masterNameU As String, _
      ByVal stencilName As String, _
      ByVal pinX As Integer, _
      ByVal pinY As Integer, _
      ByVal units As Object) As Microsoft.Office.Interop.Visio.Shape

        Dim visioApplication As Microsoft.Office.Interop.Visio.Application
        Dim visioDocuments As Microsoft.Office.Interop.Visio.Documents
        Dim stencil As Microsoft.Office.Interop.Visio.Document
        Dim masterInStencil As Microsoft.Office.Interop.Visio.Master
        Dim droppedShape As Microsoft.Office.Interop.Visio.Shape = Nothing
        Dim cellPinX As Microsoft.Office.Interop.Visio.Cell
        Dim cellPinY As Microsoft.Office.Interop.Visio.Cell
        Dim pinXInternal As Double
        Dim pinYInternal As Double

        visioApplication = CType(pageToDrop.Application,  _
            Microsoft.Office.Interop.Visio.Application)

        Try

            ' Verify that all incoming string parameters are not of zero 
            ' length, except for the ones that have default values as ""
            ' and the output parameters.
            If (masterNameU.Length() = 0) Then
                Throw New System.ArgumentNullException("masterNameU", _
                 "Zero length string input.")
            End If

            If (stencilName.Length() = 0) Then
                Throw New System.ArgumentNullException("stencilName", _
                 "Zero length string input.")
            End If

            masterInStencil = Nothing
            Try
                masterInStencil = visioApplication.ActiveDocument.Masters.ItemU(masterNameU)
            Catch ex As Exception
            End Try

            If masterInStencil Is Nothing Then
                ' Find the stencil in the Documents collection by name.
                visioDocuments = visioApplication.Documents

                Try
                    stencil = visioDocuments.Item(stencilName)
                Catch err As System.Runtime.InteropServices.COMException
                    ' The stencil is not in the collection; open
                    ' it as a docked stencil.
                    stencil = visioDocuments.OpenEx(stencilName, _
                        CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked + _
                            Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visAddHidden))
                End Try

                ' Get a master from the stencil by its universal name.
                masterInStencil = stencil.Masters.ItemU(masterNameU)
            End If

            ' Convert the PinX and PinY into internal units.
            pinXInternal = visioApplication.ConvertResult(pinX, units, _
                Microsoft.Office.Interop.Visio.VisUnitCodes.visInches)

            pinYInternal = visioApplication.ConvertResult(pinY, units, _
                Microsoft.Office.Interop.Visio.VisUnitCodes.visInches)

            ' Drop the master on the page that is passed in.
            ' Set the PinX and PinY using pinXInternal
            ' and pinYInternal respectively.
            droppedShape = pageToDrop.Drop(masterInStencil, pinXInternal, _
             pinYInternal)

            ' Update the units for PinX and PinY of the shape.
            cellPinX = droppedShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio. _
                VisSectionIndices.visSectionObject), _
                CShort(Microsoft.Office.Interop.Visio. _
                VisRowIndices.visRowXFormOut), _
                CShort(Microsoft.Office.Interop.Visio. _
                VisCellIndices.visXFormPinX))

            cellPinY = droppedShape.CellsSRC( _
                CShort(Microsoft.Office.Interop.Visio. _
                VisSectionIndices.visSectionObject), _
                CShort(Microsoft.Office.Interop.Visio. _
                VisRowIndices.visRowXFormOut), _
                CShort(Microsoft.Office.Interop.Visio. _
                VisCellIndices.visXFormPinY))

            cellPinX.Result(units) = pinX
            cellPinY.Result(units) = pinY

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return droppedShape

    End Function


       '********* visio snippet vb.net vis0010vb ******************
    Public Function ConnectWithDynamicGlueAndConnector _
        (ByVal shapeFrom As Microsoft.Office.Interop.Visio.Shape, _
        ByVal shapeTo As Microsoft.Office.Interop.Visio.Shape) _
        As Visio.Shape

        Const MESSAGE_NOT_SAME_PAGE As String = _
            "Both the shapes are not on the same page."


        ' modified from sdk so that the connector is returned
        Dim connector As Microsoft.Office.Interop.Visio.Shape = Nothing

        Dim stencil As Microsoft.Office.Interop.Visio.Document
        Dim masterInStencil As Microsoft.Office.Interop.Visio.Master
        Dim beginX As Microsoft.Office.Interop.Visio.Cell
        Dim endX As Microsoft.Office.Interop.Visio.Cell


        Try

            If drawingPage Is Nothing Then
                drawingPage = drawingApplication.ActivePage
            End If

            ' Verify that the shapes are on the same page.
            If (shapeFrom.ContainingPage Is shapeTo.ContainingPage) Then

                If TestStencilLoaded(drawingApplication, "Basic Flowchart Shapes (US units).vss") = False Then
                    stencil = drawingApplication.Documents.OpenEx( _
                        "Basic Flowchart Shapes (US units).vss", _
                        CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenHidden))
                Else
                    stencil = drawingApplication.Documents("Basic Flowchart Shapes (US units).vss")
                End If

                ' Get the Dynamic connector master on the stencil by its
                ' universal name.
                masterInStencil = stencil.Masters.ItemU( _
                    "Dynamic Connector")

                ' Drop the Dynamic Connector on the active page.
                Connector = drawingPage.Drop( _
                    masterInStencil, 0, 0)

                ' Connect the begin point of the Dynamic Connector to the
                ' PinX cell of the first 2-D shape.
                beginX = connector.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisSectionIndices.visSectionObject), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisRowIndices.visRowXForm1D), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisCellIndices.vis1DBeginX))

                beginX.GlueTo(shapeFrom.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisSectionIndices.visSectionObject), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisRowIndices.visRowXFormOut), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisCellIndices.visXFormPinX)))

                ' Connect the end point of the Dynamic Connector to the
                ' PinX cell of the second 2-D shape.
                endX = connector.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisSectionIndices.visSectionObject), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisRowIndices.visRowXForm1D), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisCellIndices.vis1DEndX))

                endX.GlueTo(shapeTo.CellsSRC( _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisSectionIndices.visSectionObject), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisRowIndices.visRowXFormOut), _
                    CShort(Microsoft.Office.Interop.Visio. _
                        VisCellIndices.visXFormPinX)))

            Else

                ' Processing cannot continue because the shapes are not on
                ' the same page.
                System.Diagnostics.Debug.WriteLine(MESSAGE_NOT_SAME_PAGE)

            End If

        Catch com As COMException
            ' add com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' add exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return connector

    End Function
#End Region

#Region " visio extra windows "


    ' these are visio window types for when we want to open and close things
    '
    Public Const visVWTAnchorBarAddon As Integer = 10
    ' Window created by an add-on that has tabs at the bottom when merged (floating, anchored, or docked window)
    Public Const visVWTAnchorBarBuiltIn As Integer = 6
    ' Visio built-in window that has tabs at the bottom when merged— presently, the Custom Properties, Size & Position, Drawing Explorer, Master Explorer, and Pan & Zoom windows (floating, anchored, or docked windows).
    Public Const visVWTApplication As Integer = 5
    ' Microsoft Office Visio application window.
    Public Const visVWTDockedStencilAddon As Integer = 11
    'An add-on window that has docked stencil behavior.
    Public Const visVWTDockedStencilBuiltIn As Integer = 7
    ' Stencil window docked in a drawing window.
    Public Const visVWTDrawing As Integer = 1
    ' Drawing window (MDI frame window).
    Public Const visVWTDrawingAddon As Integer = 8
    'Drawing window created by an add-on (MDI frame window).
    Public Const visVWTIcon As Integer = 4
    'Icon editing window (MDI frame window).        
    Public Const visVWTInvalWinID As Integer = -1
    'Window has no ID.
    Public Const visVWTMasterGroupWin As Integer = 96
    'A group editing window of a group in a master.
    Public Const visVWTMasterWin As Integer = 64
    'A master drawing page window.
    Public Const visVWTPageGroupWin As Integer = 160
    'A group editing window of a group on a page.
    Public Const visVWTPageWin As Integer = 128
    'A drawing window showing a page.
    Public Const visVWTSheet As Integer = 3
    'ShapeSheet window (MDI frame window).
    Public Const visVWTStencil As Integer = 2
    'Stencil window (MDI frame window).
    Public Const visVWTStencilAddon As Integer = 9
    'Add-on window that has stencil window behavior.
    Public Const visVWTWinIDCustProp As Integer = 1658
    'When Window.Type is visAnchorBarBuiltIn, Custom Properties window.
    Public Const visVWTWinIDDrawingExplorer As Integer = 1721
    'When Window.Type is visAnchorBarBuiltIn, Drawing Explorer window.
    Public Const visVWTWinIDFormulaTracing As Integer = 1781
    'When Window.Type is visAnchorBarBuiltIn, ShapeSheet Formula Tracing window.
    Public Const visVWTWinIDMasterExplorer As Integer = 1916
    'When Window.Type is visAnchorBarBuiltIn, Master Explorer window in master editing window.
    Public Const visVWTWinIDPanZoom As Integer = 1653
    'When Window.Type is visAnchorBarBuiltIn, Pan & Zoom window.
    Public Const visVWTWinIDShapeSearch As Integer = 1669
    'When Window.Type is visAnchorBarBuiltIn, Shapes window.
    Public Const visVWTWinIDSizePos As Integer = 1670
    'When Window.Type is visAnchorBarBuiltIn, Size & Position window.
    Public Const visVWTWinIDStencilExplorer As Integer = 1796
    'When Window.Type is visAnchorBarBuiltIn, Drawing Explorer window in MDI stencil window.
    Public Const visVWTWinOther As Integer = 0
    'Unknown window type.


    Public Sub getVisioExtraWindow(ByVal targetWindow As Microsoft.Office.Interop.Visio.Window)

        Dim sbVisWinType As New StringBuilder
        Dim intVisWinCount As Integer
        Dim strWinIndex As String
        Dim strWinName As String
        Dim strWinType As String
        Dim strWinID As String
        Dim vsoWindow As Microsoft.Office.Interop.Visio.Window


        sbVisWinType.Length = 0
        intVisWinCount = targetWindow.Windows.Count
        If 0 < intVisWinCount Then
            sbVisWinType.Append("Windows " & intVisWinCount.ToString & vbCrLf)
            For Each vsoWindow In targetWindow.Windows
                strWinID = ""
                strWinName = ""
                With vsoWindow
                    Select Case .ID
                        Case visVWTApplication
                            strWinID = "visApplication"
                        Case visVWTDockedStencilAddon
                            strWinID = "visDockedStencilAddon"
                        Case visVWTDockedStencilBuiltIn
                            strWinID = "visDockedStencilBuiltIn"
                        Case visVWTDrawing
                            strWinID = "visDrawing"
                        Case visVWTDrawingAddon
                            strWinID = "visDrawingAddon"
                        Case visVWTIcon
                            strWinID = "visIcon"
                        Case visVWTInvalWinID
                            strWinID = "visInvalWinID"
                        Case visVWTMasterGroupWin
                            strWinID = "visMasterGroupWin"
                        Case visVWTMasterWin
                            strWinID = "visMasterWin"
                        Case visVWTPageGroupWin
                            strWinID = "visPageGroupWin"
                        Case visVWTPageWin
                            strWinID = "visPageWin"
                        Case visVWTSheet
                            strWinID = "visSheet"
                        Case visVWTStencil
                            strWinID = "visStencil"
                        Case visVWTStencilAddon
                            strWinID = "visStencilAddon"
                        Case visVWTWinOther
                            strWinID = "visWinOther"
                        Case visVWTWinIDCustProp
                            strWinID = "visWinIDCustProp"
                        Case visVWTWinIDDrawingExplorer
                            strWinID = "visWinIDDrawingExplorer"
                        Case visVWTWinIDFormulaTracing
                            strWinID = "visWinIDFormulaTracing"
                        Case visVWTWinIDMasterExplorer
                            strWinID = "visWinIDMasterExplorer"
                        Case visVWTWinIDPanZoom
                            strWinID = "visWinIDPanZoom"
                        Case visVWTWinIDShapeSearch
                            strWinID = "visWinIDShapeSearch"
                        Case visVWTWinIDSizePos
                            strWinID = "visWinIDSizePos"
                        Case visVWTWinIDStencilExplorer
                            strWinID = "visWinIDStencilExplorer"
                        Case visVWTAnchorBarAddon
                            strWinID = "visAnchorBarAddon"
                        Case visVWTAnchorBarBuiltIn
                            strWinID = "visAnchorBarBuiltIn"
                        Case Else
                            strWinID = "Unknown"
                    End Select
                    strWinName = .Caption.ToString
                    strWinIndex = .ID.ToString
                    strWinType = .Type.ToString
                End With
                sbVisWinType.Append(strWinName & ", " & strWinIndex & ", " & strWinID & ", " & strWinType & ", " & vbCrLf)
            Next vsoWindow
            MsgBox(sbVisWinType.ToString)
        End If

    End Sub


    Private Sub setVisioExtraWindowVisibility( _
            ByVal targetWindow As Microsoft.Office.Interop.Visio.Window, _
            ByVal visVWT As Microsoft.Office.Interop.Visio.VisWinTypes, _
            ByVal visible As Boolean)

        Dim searchWindow As Microsoft.Office.Interop.Visio.Window

        Try
            ' for identified window set the visibility attribute
            searchWindow = targetWindow.Windows.ItemFromID(visVWT)
            If (Not searchWindow Is Nothing) Then
                searchWindow.Visible = visible
            End If

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Finally
        End Try

    End Sub

    Public Sub ShowStencils _
        (ByVal vsoApp As Visio.Application, _
         ByVal blnVisible As Boolean)


        Try


            Dim visWindows As Visio.Windows = vsoApp.Windows
            Dim visWin As Visio.Window
            For Each visWin In visWindows
                If visWin.Type = visVWTStencil Then
                    visWin.Visible = blnVisible
                End If
            Next

            Dim visDocuments As Visio.Documents = vsoApp.Documents
            Dim visDoc As Visio.Document
            For Each visDoc In visDocuments
                If visDoc.Type = Visio.VisDocumentTypes.visTypeStencil Then

                End If
            Next


        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Finally
        End Try


    End Sub



    Public Sub ClearExtraWindows _
            (ByVal targetWindow As Microsoft.Office.Interop.Visio.Window)

        Dim vsoWindow As Microsoft.Office.Interop.Visio.Window

        Try
            For Each vsoWindow In targetWindow.Windows
                ' if its an addon or shape-stencil turn off visibility
                If vsoWindow.Type = 10 Or vsoWindow.Type = 7 Then
                    ' vsoWindow.Visible = False
                    setVisioExtraWindowVisibility(targetWindow, vsoWindow.ID, False)
                End If
            Next

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Finally
        End Try

    End Sub

#End Region

#Region " Page Support "

    ' TODO consider rewrite page field data to use collections instead of arrays
    Public Function InitPageFieldsSimple _
        (ByVal strPageName As String) _
        As String(,)


        Dim lclArray(3, 1) As String

        ' the page will always use the local page name with this call
        lclArray(0, 0) = "PageID"
        lclArray(0, 1) = ""

        lclArray(1, 0) = "locSiteId"
        lclArray(1, 1) = strPageName

        lclArray(2, 0) = "locBuilding"
        lclArray(2, 1) = "BuildingA"

        lclArray(3, 0) = "locIntLocation"
        lclArray(3, 1) = "RoomA"


        InitPageFieldsSimple = lclArray


    End Function


    '
    ' pass in an arraylist of property names and values
    ' to add to the page. then create rectangles in the
    ' upper left with text fields that reference the
    ' custom properties that we just created
    '
    '********* visio snippet vb.net vis0117vb ******************
    Public Sub AddArrayPropertyBoxesToPage _
            (ByVal visPage As Visio.Page, _
            Optional ByVal arrInput As Object = Nothing)


        Dim vsoApp As Visio.Application = visPage.Application


        Try


            vsoApp.ScreenUpdating = False
            vsoApp.InhibitSelectChange = True
            vsoApp.DeferRecalc = True

            Dim arrProp(,) As String
            If arrInput Is Nothing Then
                arrProp = InitPageFieldsSimple(visPage.Name)
            Else
                arrProp = arrInput
            End If

            Dim objRect As Visio.Shape
            Dim blnResult As Boolean
            Dim visPageSheet As Visio.Shape = visPage.PageSheet

            Dim iEnd As Double
            Dim iTop As Double
            Dim iStart As Double
            Dim iBottom As Double

            ' start .75 from left side of page
            iStart = 0.75
            ' the text box is 3in long
            iEnd = iStart + 3

            Dim visCell As Visio.Cell

            Dim intArr As Integer = 0
            Dim strProperty As String = "prop."
            Dim strField As String
            Dim strSpacer As String = " : "
            Dim strPage As String = "ThePage!Prop."

            If visPageSheet.SectionExists(VisSectionIndices.visSectionProp, False) = False Then
                visPageSheet.AddSection(VisSectionIndices.visSectionProp)
            End If

            ' where do we want the text
            ' assumes initial page size of 8.5in and we
            ' put it .5in below the top, each box is
            ' .2in high
            ' single rack pageheight = 11 ft, pagescale = 1 in, drawingscale = 1 ft
            ' row pageheight = 22 ft 8 in, pagescale = 0.375 in, drawingscale = 1 ft

            Dim dblPageHeight As Double = visPageSheet.Cells("PageHeight").ResultIU
            Dim dblPageScale As Double = visPageSheet.Cells("PageScale").ResultIU
            Dim dblDrawingScale As Double = visPageSheet.Cells("DrawingScale").ResultIU

            Dim dblTop As Double = dblPageHeight * (dblPageScale / dblDrawingScale)
            Dim dblMargin As Double = 0.5

            For intArr = 0 To UBound(arrProp)

                ' put the initial box below the top marging
                iTop = (dblTop - dblMargin) - (intArr * 0.2)

                iBottom = iTop - 0.2

                strField = strProperty & arrProp(intArr, 0)
                ' create and initialize the custom properties
                ' we will always add a page id property to the page
                AddCustomProperty( _
                    visPageSheet, _
                    arrProp(intArr, 0), _
                    arrProp(intArr, 0), _
                    arrProp(intArr, 0), _
                    VisCellVals.visPropTypeString, "", "", _
                    False, False, "attrPage")
                ' if they don't pass a page name then take the
                ' name from the page properties
                If LCase(arrProp(intArr, 0)) = "pageid" _
                    And arrProp(intArr, 1) = "" Then
                    visCell = visPageSheet.Cells("prop.pageid")
                    SetCellValueToString(visCell, visPage.NameU)
                Else
                    ' anything other than a blank pageid is handled here
                    visCell = visPageSheet.Cells(strField)
                    SetCellValueToString(visCell, arrProp(intArr, 1))
                End If

                ' now create a box and put a text field into it
                ' pointed at the custom property
                objRect = visPage.DrawRectangle(iStart, iTop, iEnd, iBottom)
                TextAntiScaling(objRect, intArr)
                objRect.Cells("Char.Size").Formula = "9Pt" ' this was so we could put in a guid and needed more room
                blnResult = AddTextFieldToShape(objRect, _
                                arrProp(intArr, 0) & strSpacer, _
                                strPage & arrProp(intArr, 0), _
                                VisFieldFormats.visFmtStrNormal)

            Next intArr

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        Finally

            vsoApp.ScreenUpdating = True
            vsoApp.InhibitSelectChange = False
            vsoApp.DeferRecalc = False

        End Try

    End Sub

    '*********************************************************************
    '*********************************************************************
    '
    '           Change Page Order (from John Marshall's site)
    '
    '*********************************************************************
    '*********************************************************************
    Public Function ChangePageOrder _
                    (ByVal vsoDocument As Visio.Document, _
                    ByVal intPageIndex1 As Integer, _
                    ByVal intPageIndex2 As Integer) _
                    As Boolean

        Dim intTemp As Integer
        Dim vsoPage1 As Visio.Page
        Dim vsoPage2 As Visio.Page


        ' Determine the greater intPageIndex value.
        intTemp = intPageIndex1
        If (intPageIndex1 < intPageIndex2) Then
            intTemp = intPageIndex2
        End If


        If (vsoDocument.Pages.Count < intTemp) _
            Or intPageIndex1 < 1 _
            Or intPageIndex2 < 1 _
            Then

            MsgBox("At least one of the page indices" _
                & " is not valid. The page indices must" _
                & " be between 0 and " _
                & vsoDocument.Pages.Count)

            Return vbFalse
        End If

        ' Get a reference to the Page object that corresponds
        ' with intPageIndex1.
        vsoPage1 = vsoDocument.Pages.ItemU(intPageIndex1)

        If (vsoPage1.Background <> 0) Then
            MsgBox("Page " & vsoPage1.Index _
                & " is not a foreground page(1)")
            Return vbFalse
        End If

        ' Get a reference to the Page object that corresponds
        ' with intPageIndex2.
        vsoPage2 = vsoDocument.Pages.ItemU(intPageIndex2)
        ' subLogMessage "Page " & vsoPage2.Name
        If (vsoPage2.Background <> 0) Then
            MsgBox("Page " & vsoPage2.Index _
                & " is not a foreground page(2)")
            Return vbFalse
        End If

        ' Swap the indices of the pages.
        intTemp = vsoPage1.Index
        vsoPage1.Index = vsoPage2.Index
        vsoPage2.Index = intTemp

        Return vbTrue

    End Function

    '
    '
    '
    Public Function CopyPageFormat _
        (ByVal tgtPage As Visio.Page, _
        ByVal srcPage As Visio.Page) _
        As Boolean

        Dim tgtPageSheet As Visio.Shape
        Dim srcPageSheet As Visio.Shape

        On Error GoTo ErrHandler

        tgtPageSheet = tgtPage.PageSheet
        srcPageSheet = srcPage.PageSheet


        'Debug.Print "change size type"
        tgtPageSheet.Cells("DrawingSizeType").FormulaU = srcPageSheet.Cells("DrawingSizeType").FormulaU
        'Debug.Print "change scale type"
        tgtPageSheet.Cells("DrawingScaleType").FormulaU = srcPageSheet.Cells("DrawingScaleType").FormulaU
        'Debug.Print " drawing scale"
        tgtPageSheet.Cells("DrawingScale").FormulaU = srcPageSheet.Cells("DrawingScale").FormulaU
        'Debug.Print " page scale "
        tgtPageSheet.Cells("PageScale").FormulaU = srcPageSheet.Cells("PageScale").FormulaU
        'Debug.Print "width"
        tgtPageSheet.Cells("PageWidth").FormulaU = srcPageSheet.Cells("PageWidth").FormulaU
        'Debug.Print "height"
        tgtPageSheet.Cells("PageHeight").FormulaU = srcPageSheet.Cells("PageHeight").FormulaU
        'Debug.Print "route"
        tgtPageSheet.Cells("RouteStyle").FormulaU = srcPageSheet.Cells("RouteStyle").FormulaU

        CopyPageFormat = True

ExitHandler:

        Exit Function

ErrHandler:

        Debug.Print("Error CopyPageFormat " & Err.Number & ": " & Err.Description)
        CopyPageFormat = False
        Resume ExitHandler

    End Function

    '
    '
    '
    Public Function CopyPage _
            (ByVal tgtPage As Visio.Page, _
            ByVal srcPage As Visio.Page) _
            As Boolean

        Dim selDraw As Visio.Selection
        Dim strPageName As String
        Dim curWin As Visio.Window
        Dim strCurStep As String
        Dim lngX As Int32
        Dim lngY As Int32
        Dim visCell As Visio.Cell
        Dim pagSheet As Visio.Shape
        Dim srcWin As Visio.Window
        Dim tgtWin As Visio.Window

        On Error GoTo CopyPage_Err

        ' go to the source window
        strCurStep = "activate source win"
        srcWin = srcPage.Document.Application.ActiveWindow
        srcWin.Activate()
        srcWin.Page = srcPage.Name
        ' brute force method of copy
        strCurStep = "Copy source"
        srcWin.SelectAll()
        srcWin.Group()
        selDraw = tgtPage.Application.ActiveWindow.Selection


        ' now go and paste it
        strCurStep = "activate target win"
        tgtWin = tgtPage.Document.Application.ActiveWindow
        tgtWin.Activate()
        strCurStep = "set target active page"
        tgtWin.Page = tgtPage.Name

        pagSheet = tgtPage.PageSheet
        visCell = pagSheet.Cells("pageheight")
        lngY = visCell.ResultIU / 2
        visCell = pagSheet.Cells("pagewidth")
        lngX = visCell.ResultIU / 2
        tgtPage.Application.AlertResponse = 7
        tgtPage.Drop(selDraw, lngX, lngY)
        tgtWin.Page = tgtPage.Name

        tgtPage.Application.AlertResponse = 0

        srcWin.Activate()
        srcWin.DeselectAll()


        CopyPage = True

CopyPage_Exit:

        Exit Function

CopyPage_Err:

        Debug.Print("Error CopyPage Cur Step = " & strCurStep)
        Debug.Print("Error CopyPage " & Err.Number & ": " & Err.Description)
        CopyPage = False

    End Function

    '
    '
    '
    Public Sub CreateTableOfContents(ByVal tgtDoc As Visio.Document)

        ' creates a shape for each page in the drawing on the first page of the
        ' drawing then adds a hyperlink to each shape so you can click and go
        ' to that page

        ' define a toc shape
        Dim TOCEntry As Visio.Shape
        Dim PageToIndex As Visio.Page
        Dim X As Integer
        Dim hlink As Visio.Hyperlink
        Dim objPage As Visio.Page
        Dim objPageSheet As Visio.Shape
        Dim objCell As Visio.Cell
        Dim intPageCount As Integer
        Dim dblP As Double          ' page width
        Dim dblB As Double          ' border width

        Dim dblIX As Double
        Dim dblIY As Double
        Dim dblMaxIX As Double
        Dim dblIH As Double
        Dim dblIW As Double

        On Error GoTo ErrHandler

        dblIX = 0       ' default
        dblIH = 0.3     ' default
        dblIW = 4       ' default change based on hop count
        dblB = 0.75     ' bacground border
        dblIY = dblB    ' default


        objPage = tgtDoc.Pages("Front Page")
        intPageCount = tgtDoc.Pages.Count
        objPageSheet = objPage.PageSheet
        ' set the width according to the page, count * two so have spaces
        dblP = objPageSheet.Cells("PageWidth").Result("")
        ' we double the number of objects so that they space nicely
        dblIW = (dblP - (2 * dblB)) / (intPageCount * 2)
        If dblIW > 1.5 Then
            dblIW = 1.5
        End If

        ' Debug.Print "dblIW " & dblIW

        ' loop through all the pages you have
        For Each PageToIndex In tgtDoc.Pages

            ' you may want to refine this and use a top down algorithm with
            ' something smaller than 1 inch increments.
            X = PageToIndex.Index

            ' draw a rectangle for each page to hold the text
            TOCEntry = objPage.DrawRectangle(X * dblIW, 0, (X * dblIW) + dblIW, dblIH)
            objCell = TOCEntry.Cells("Char.Size")
            objCell.Formula = "=6 pt."

            ' write the page name in the rectangle
            TOCEntry.Text = PageToIndex.Name & " " & X

            ' add a hyperlink to point to the page to you can just go there
            ' with a click

            ' need to create a handle to add the hyperlink
            hlink = TOCEntry.AddHyperlink
            ' add a description
            hlink.Description = PageToIndex.Name
            ' add the page name as an address
            hlink.SubAddress = PageToIndex.Name

        Next
        Exit Sub

ErrHandler:

        Debug.Print("CreateTOC " & Err.Description)

    End Sub

    '*********************************************************************
    '*********************************************************************
    '
    '   this is where we initialize the page text rectangles with user
    '    cells and then change the necessary cells so that if
    '    the page size changes the rectangles will remain as
    '   they appeared before the scale change
    '
    '*********************************************************************
    '*********************************************************************

    '********* visio snippet vb.net vis0100vb ******************  
    Public Sub TextAntiScaling _
                (ByVal objRect As Microsoft.Office.Interop.Visio.Shape, _
                ByVal intFieldNr As Integer)

        Dim objCell As Cell
        Dim blnResult As Boolean

        Try


            objRect.Name = "textfield_" & CStr(intFieldNr)

            blnResult = AddUserPropertyToShape(objRect, "width", "width", "width", _
                    objRect.Cells("Width").ResultIU, "width")
            blnResult = AddUserPropertyToShape(objRect, "height", "height", "height", _
                    objRect.Cells("height").ResultIU, "height")
            blnResult = AddUserPropertyToShape(objRect, "pinX", "pinX", "pinX", _
                    objRect.Cells("pinx").ResultIU, "pinX")
            blnResult = AddUserPropertyToShape(objRect, "piny", "piny", "piny", _
                    objRect.Cells("piny").ResultIU, "piny")


            objCell = objRect.Cells("width")
            objCell.Formula = "user.width*(ThePage!DrawingScale/ThePage!PageScale)"
            objCell = objRect.Cells("height")
            objCell.Formula = "user.height*(ThePage!DrawingScale/ThePage!PageScale)"
            objCell = objRect.Cells("pinx")
            objCell.Formula = "user.pinx*(ThePage!DrawingScale/ThePage!PageScale)"
            objCell = objRect.Cells("piny")
            objCell.Formula = "user.piny*(ThePage!DrawingScale/ThePage!PageScale)"

            objRect.Cells("Para.HorzAlign").Formula = VisCellVals.visHorzLeft


        Catch com As COMException
            ' insert com exception handler here
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If

        Catch ex As Exception
            ' insert exception handler here
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try
    End Sub




#End Region

#Region " containers / Lists "



    ' the internal container stencil
    Const masterContainerStencilU As String = ""
    ' our default container
    Const masterContainerNameU As String = "Container 3"
    ' wireframe stencil for list (vertical w/header on top) control
    Const stencilWFControl As String = "wfctrl_u.vss"
    ' wireframe master for vertical list
    Const masterListBox As String = "List box"
    ' wireframe master for vertical list item
    Const masterListBoxItem As String = "List box item"
    ' wireframe stencil for list (vertical w/header on side and horizontal) toolbar 
    Const stencilWFToolbar As String = "wftlbr_u.vss"
    Const masterMenuBar As String = "Menu bar"
    Const masterMenuBarItem As String = "Menu bar item"
    Const masterDropDown As String = "Drop-down menu"
    Const masterDropDownItem As String = "Menu item"

    Const constDefaultContainerHeight As String = "1 in"
    Const constDefaultContainerWidth As String = "2 in"
    ' start .75 from left side of page and the top
    Const constDefaultContainerMargin As String = "0.75 in"

    '
    ' simple drop the container on the page, name it, and add a header
    '
    Public Function addContainerToPage _
            (ByVal containerMaster As String, _
             ByVal containerName As String, _
            Optional ByVal containerText As String = "New Container") _
            As Microsoft.Office.Interop.Visio.Shape

        ' define shape
        Dim visShape As Microsoft.Office.Interop.Visio.Shape = Nothing

        Try


            Try
                visShape = drawingPage.Shapes(containerName)
            Catch ex As Exception
            End Try

            ' if it's already there, get out
            If visShape IsNot Nothing Then Return visShape

            ' define stencildoc
            Dim visStencil As Microsoft.Office.Interop.Visio.Document = Nothing
            visStencil = Me.drawingApplication.Documents.OpenEx(drawingApplication.GetBuiltInStencilFile _
                                            (VisBuiltInStencilTypes.visBuiltInStencilContainers, VisMeasurementSystem.visMSUS), VisOpenSaveArgs.visOpenHidden)

            Me.drawingApplication.Windows.ItemEx(drawingDocument.Name).Activate()

            visShape = Me.drawingPage.DropContainer(visStencil.Masters.ItemU(containerMaster), Nothing)
            visShape.Text = containerText
            If containerName <> "" Then
                visShape.Name = containerName
                visShape.NameU = containerName
            End If

            visShape.Cells("height").Formula = constDefaultContainerHeight
            visShape.Cells("width").Formula = constDefaultContainerWidth

            visShape.ContainerProperties.ResizeAsNeeded = VisContainerAutoResize.visContainerAutoResizeExpandContract

            ' do not allow a shape drop to change container
            visShape.ContainerProperties.LockMembership = True

            visStencil.Close()


        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return visShape

    End Function

    '
    ' the default for container behaviour is to expand to include the shape, so that the container behaves a little
    ' better we move the shape over to the container before including it in the container
    '
    Public Sub AddShapeToContainer _
            (ByVal shpContainer As Microsoft.Office.Interop.Visio.Shape, _
            ByVal shpMember As Microsoft.Office.Interop.Visio.Shape)

        Try

            ' get an enumerable list of shape ids that are already in the container
            Dim colMembers As Collection = getMembersOfContainer(shpContainer)
            ' if already in there, get out
            If colMembers.Contains(shpMember.ID.ToString) = True Then
                Exit Sub
            End If

            ' get the existing size of the container
            Dim dblContainerPinX As Double = shpContainer.Cells("pinX").ResultIU
            Dim dblContainerPinY As Double = shpContainer.Cells("pinY").ResultIU
            Dim dblContainerWidth As Double = shpContainer.Cells("Width").ResultIU
            Dim dblContainerSep As Double = shpContainer.ContainerProperties.GetMargin(VisUnitCodes.visInches)

            ' allow us to add the shape
            shpContainer.ContainerProperties.LockMembership = False

            ' put the new member at the same height as the container
            shpMember.Cells("pinY").FormulaU = dblContainerPinY
            ' put the shape to the right of the container so that when the container expands it will go horizontally
            shpMember.Cells("pinX").FormulaU = dblContainerPinX + (dblContainerWidth / 2) + dblContainerSep + shpMember.Cells("Width").ResultIU

            shpContainer.ContainerProperties.AddMember(shpMember, VisMemberAddOptions.visMemberAddUseResizeSetting)

            ' lock the container back up
            shpContainer.ContainerProperties.LockMembership = True


        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    '
    ' pass in a list, a member, optional position in list, optional list direction 
    '
    Public Sub AddShapeToList _
                (ByVal shpList As Microsoft.Office.Interop.Visio.Shape, _
                ByVal shpMember As Microsoft.Office.Interop.Visio.Shape, _
                Optional ByVal intPosition As Integer = -1)

        Try

            ' get a list of shape ids that are already in the container
            Dim colMembers As Collection = getMembersOfContainer(shpList)
            If colMembers.Contains(shpMember.ID.ToString) = True Then
                Exit Sub
            End If

            ' put it at the end of the list unless otherwise posted
            If intPosition < 0 Then
                intPosition = colMembers.Count + 1
            End If

            ' allow us to add the shape
            shpList.ContainerProperties.LockMembership = False

            shpList.ContainerProperties.InsertListMember(shpMember, intPosition)

            ' lock the List back up
            shpList.ContainerProperties.LockMembership = True

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    '
    ' drop a group of items on the page and pass back the shapeids
    ' add the ability to define a height and width. 
    '
    Public Function dropDropDownBoxItems _
                (ByVal colInput As Collection, _
                 ByVal strMasterName As String, _
                 ByVal strStencilName As String, _
                 Optional ByVal strWidth As String = "", _
                 Optional ByVal strHeight As String = "", _
                 Optional ByVal blnForceUserAttr As Boolean = False) _
                As Collection


        Dim colReturn As Collection = New Collection

        Try

            Dim strName As String
            Dim intX As Integer

            Dim shapeDropDownItem As Microsoft.Office.Interop.Visio.Shape = Nothing

            For intX = 1 To colInput.Count

                strName = colInput(intX).ToString
                'shapeDropDownItem = DropMasterOnPage(drawingPage, masterDropDownItem, stencilWFToolbar, 0, 0, VisUnitCodes.visInches)
                shapeDropDownItem = DropMasterOnPage(drawingPage, strMasterName, strStencilName, 0, 0, VisUnitCodes.visInches)
                shapeDropDownItem.Text = strName
                If blnForceUserAttr = False Then
                    shapeDropDownItem.Name = strName
                    shapeDropDownItem.NameU = strName
                End If

                ForceUserProperty(shapeDropDownItem, "AttrKey", strName)



                If strWidth <> "" Then
                    shapeDropDownItem.Cells("width").Formula = strWidth
                    shapeDropDownItem.Cells("height").Formula = strHeight
                End If

                colReturn.Add(shapeDropDownItem.ID)

            Next


        Catch com As COMException
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return colReturn

    End Function

    '
    ' pass in a collection of shapeids and load them into a drop down box control, return the populated control
    ' allow the user to call alignment and direction
    '
    Public Function loadListControl _
                (ByVal colObjects As Collection, _
                Optional ByVal shpAlign As VisListAlignment = VisListAlignment.visListAlignLeftOrTop, _
                Optional ByVal shpDir As VisListDirection = VisListDirection.visListDirTopToBottom, _
                Optional ByVal dblListSpace As Double = 0.1, _
                Optional ByVal strMaster As String = "Drop Down Box") _
                As Microsoft.Office.Interop.Visio.Shape

        'DropDownList control
        Dim shapeDropDownBox As Microsoft.Office.Interop.Visio.Shape = Nothing
        Dim shapeDropDownItem As Microsoft.Office.Interop.Visio.Shape = Nothing

        Try

            ' use the modified drop down box from our custom stencil
            Dim strStencil As String = "DCRackBase.vss"
            strStencil = _CustomStencilPath & strStencil
            shapeDropDownBox = DropMasterOnPage(drawingPage, strMaster, strStencil, 0, 0, VisUnitCodes.visInches)
            ' the "real" drop down box
            'shapeDropDownBox = DropMasterOnPage(drawingPage, masterDropDown, stencilWFToolbar, 0, 0, VisUnitCodes.visInches)
            clearListContainer(shapeDropDownBox)

            shapeDropDownBox.ContainerProperties.SetListSpacing(VisUnitCodes.visInches, dblListSpace)
            shapeDropDownBox.ContainerProperties.ListAlignment = shpAlign
            shapeDropDownBox.ContainerProperties.ListDirection = shpDir

            For Each shapeID In colObjects
                Try
                    ' make sure the shapeid is on the current drawing page
                    shapeDropDownItem = drawingPage.Shapes.ItemFromID(shapeID)
                Catch
                End Try

                If shapeDropDownItem IsNot Nothing Then
                    AddShapeToList(shapeDropDownBox, shapeDropDownItem, -1)
                End If
            Next

        Catch com As COMException
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        Return shapeDropDownBox

    End Function

    '
    ' empty a list of items
    '
    Public Sub clearListContainer(ByRef visList As Microsoft.Office.Interop.Visio.Shape)


        Try

            Dim memberArray As Array = visList.ContainerProperties.GetListMembers
            Dim visShape As Microsoft.Office.Interop.Visio.Shape = Nothing
            For Each shapeItem In memberArray
                'get the shape
                visShape = drawingPage.Shapes.ItemFromID(shapeItem)
                'remove from list
                visList.ContainerProperties.RemoveMember(visShape)
                'delete the shape 
                visShape.Delete()
            Next



        Catch com As COMException
            '********* visio snippet vb.net vis0056vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            '********* visio snippet vb.net vis0059vb ******************
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try
    End Sub

    '
    '  pass in a container/list and return a collection of shapeIds
    '
    Public Function getMembersOfContainer _
                (ByVal shpContainer As Microsoft.Office.Interop.Visio.Shape) _
                As Collection

        Dim colReturn As Collection = New Collection

        Try

            Dim visShape As Microsoft.Office.Interop.Visio.Shape = Nothing
            Dim visPage As Microsoft.Office.Interop.Visio.Page = Me.drawingPage

            For Each memberID In shpContainer.ContainerProperties.GetMemberShapes(VisContainerFlags.visContainerFlagsDefault)
                'visShape = visPage.Shapes.ItemFromID(memberID)
                colReturn.Add(memberID.ToString)
            Next


        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return colReturn

    End Function

    '
    '
    '
    Public Function getMembersOfList _
            (ByVal shpContainer As Microsoft.Office.Interop.Visio.Shape) _
            As Collection

        Dim colReturn As Collection = New Collection

        Try


            Dim colTemp As Collection = New Collection
            For Each memberID In shpContainer.ContainerProperties.GetListMembers
                'visShape = visPage.Shapes.ItemFromID(memberID)
                colReturn.Add(memberID.ToString)
            Next

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return colReturn

    End Function

    '
    ' select shapes within a container and autolayout
    '
    Public Sub layoutShapesWithinContainer(ByVal shpContainer As Visio.Shape)

        Try


            Me.drawingPage.Shapes.ItemFromID(shpContainer.ID).ContainerProperties.ResizeAsNeeded = VisContainerAutoResize.visContainerAutoResizeExpandContract
            ' make sure nothing is selected
            Me.drawingWindow.DeselectAll()

            Dim colShapes As Collection = getMembersOfContainer(shpContainer)
            If 0 < colShapes.Count Then
                For Each shapeId In colShapes
                    Me.drawingWindow.Select(drawingWindow.Page.Shapes.ItemFromID(shapeId), VisSelectArgs.visSelect)
                Next shapeId

                ' align the members - first to the left
                Me.drawingWindow.Selection.Align(VisHorizontalAlignTypes.visHorzAlignLeft, VisVerticalAlignTypes.visVertAlignNone, False)
                Me.drawingWindow.Selection.Align(VisHorizontalAlignTypes.visHorzAlignNone, VisVerticalAlignTypes.visVertAlignTop, False)
                Me.drawingWindow.Selection.LayoutIncremental _
                    (VisLayoutIncrementalType.visLayoutIncrSpace, _
                     VisLayoutHorzAlignType.visLayoutHorzAlignCenter, _
                     VisLayoutVertAlignType.visLayoutVertAlignDefault, _
                     0.375, 0.375, _
                     VisUnitCodes.visInches)

            End If

            Me.drawingWindow.DeselectAll()

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    '
    ' if a container is emptied during a solution removal get rid of the container
    '
    Public Sub removeEmptyContainers()
        Try

            Dim colReturn As Collection = New Collection

            Dim shpContainer As Visio.Shape = Nothing
            For Each containerID In Me.drawingPage.GetContainers(VisContainerNested.visContainerIncludeNested)
                colReturn.Clear()
                Try
                    shpContainer = Me.drawingPage.Shapes.ItemFromID(containerID)
                Catch
                End Try
                If shpContainer IsNot Nothing Then
                    ' just using this to get a member count
                    colReturn = getMembersOfContainer(shpContainer)
                    ' if it is empty get rid of it
                    If colReturn.Count = 0 Then
                        ' unlock it just in case
                        shpContainer.ContainerProperties.LockMembership = False
                        shpContainer.Delete()
                    End If
                End If
                System.Windows.Forms.Application.DoEvents()
            Next containerID

            ' let the system catch up
            System.Windows.Forms.Application.DoEvents()
            ' if we have removed the last container make sure the layer goes as well
            Dim arrayContainer As System.Array
            Dim visLayer As Visio.Layer = Nothing
            arrayContainer = drawingPage.GetContainers(VisContainerNested.visContainerIncludeNested)
            If arrayContainer.Length = 0 Then
                Try
                    visLayer = Me.drawingPage.Layers.Item("Container")
                Catch
                End Try
                If visLayer IsNot Nothing Then
                    ' unlock it just in case
                    visLayer.CellsC(VisCellIndices.visLayerLock).FormulaU = "0"
                    visLayer.Delete(1)
                End If
            End If

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try
    End Sub

    '
    ' pass in a shape.id 
    '
    Public Sub removeShapeFromContainers(ByVal intId As Short)


        Try

            Dim colReturn As Collection = New Collection
            Dim intShape As Short = 0
            Dim shpContainer As Visio.Shape = Nothing
            Dim visShape As Visio.Shape = Nothing
            For Each containerID In Me.drawingPage.GetContainers(VisContainerNested.visContainerIncludeNested)
                colReturn.Clear()
                shpContainer = Me.drawingPage.Shapes.ItemFromID(containerID)
                ' just using this to get a member count
                colReturn = getMembersOfContainer(shpContainer)
                For Each intShape In colReturn
                    If intId = intShape Then
                        ' allow us to add the shape
                        shpContainer.ContainerProperties.LockMembership = False

                        visShape = Me.drawingPage.Shapes.ItemFromID(intId)
                        visShape.RemoveFromContainers()
                        layoutShapesWithinContainer(shpContainer)
                        shpContainer.ContainerProperties.LockMembership = True
                    End If
                Next

            Next


        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try



    End Sub




#End Region

#Region " RecordSet "


    '
    '
    '
    Private Sub ShowSelectedObjectDataRecord _
                (ByVal visShape As Microsoft.Office.Interop.Visio.Shape)
        '
        ' this piece of code handles selecting an object and then if it
        ' is linked to a data recordset, open the external data window and
        ' select the recordset and record appropriate to the object
        '
        Dim alngDataRecordsetIDs() As Int32 = {}
        Dim lngRowId As Int32
        Dim lngRecordSetId As Int32
        Dim winExternalData As Microsoft.Office.Interop.Visio.Window
        Dim visDataRecordset As Microsoft.Office.Interop.Visio.DataRecordset

        ' get the list of recordset ids associated if any
        visShape.GetLinkedDataRecordsetIDs(alngDataRecordsetIDs)

        If UBound(alngDataRecordsetIDs) <> -1 Then
            ' take the first recordset id
            lngRecordSetId = alngDataRecordsetIDs(0)
            ' get the associate row id
            lngRowId = visShape.GetLinkedDataRow(lngRecordSetId)
            winExternalData = Me.drawingApplication.ActiveWindow.Windows.ItemFromID(VisWinTypes.visWinIDExternalData)
            ' show the external data window
            winExternalData.Visible = True
            ' set the linked row
            visDataRecordset = Me.drawingApplication.ActiveDocument.DataRecordsets.ItemFromID(lngRecordSetId)
            winExternalData.SelectedDataRecordset = visDataRecordset
            winExternalData.SelectedDataRowID = lngRowId

        End If ' test for number of recordsetids associated


    End Sub


    '
    ' columns start at one but varrowdata starts at 0
    '
    Public Function GetColumnId _
        (ByVal dcs As Visio.DataColumns, _
        ByVal strColumnName As String) _
        As Integer

        Dim intReturn As Integer
        intReturn = -1

        Dim intX As Integer

        For intX = 1 To dcs.Count
            If LCase(dcs.Item(intX).Name) = LCase(strColumnName) Then
                ' subtract one so pointer is correct
                intReturn = intX - 1
                GoTo EndSearch
            End If
        Next intX

EndSearch:

        GetColumnId = intReturn

    End Function

    '
    ' go verify that the record exists and get a count
    ' of records (used in verification)
    '
    Public Function GetFilteredRecordSetCount _
        (ByVal vsoDocument As Visio.Document, _
        ByVal strRecordSet As String, _
        ByVal strFilter As String) _
        As Integer

        On Error Resume Next

        Dim vsoRecordSets As Visio.DataRecordsets
        Dim vsoRecordSet As Visio.DataRecordset
        Dim intRecordSetCt As Integer
        Dim intX As Integer
        Dim lngRowIds As System.Array


        vsoRecordSets = vsoDocument.DataRecordsets
        intRecordSetCt = vsoRecordSets.Count

        If 0 < intRecordSetCt Then
            For intX = 1 To intRecordSetCt
                vsoRecordSet = vsoRecordSets(intX)
                If vsoRecordSet.Name = strRecordSet Then
                    lngRowIds = vsoRecordSet.GetDataRowIDs(strFilter)
                    GetFilteredRecordSetCount = UBound(lngRowIds) + 1
                    Exit Function
                End If
            Next intX
        End If

        GetFilteredRecordSetCount = 0

    End Function

    '
    '
    '
    Public Function ConvertToAdoRecordsetXML _
            (ByVal sourceDataTable As System.Data.DataTable) _
            As String

        Dim targetADOXML As String = ""
        Dim targetRecordset As ADODB.Recordset
        Dim targetADOXMLStream As ADODB.StreamClass

        Try

            targetRecordset = ConvertToADORecordset(sourceDataTable)
            targetADOXMLStream = New ADODB.StreamClass

            targetRecordset.Save(targetADOXMLStream, _
                ADODB.PersistFormatEnum.adPersistXML)

            targetADOXML = targetADOXMLStream.ReadText( _
                targetADOXMLStream.Size)


        Catch ex As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Finally
        End Try

        Return targetADOXML


    End Function

    '
    '
    '
    Public Function ConvertToADORecordset _
                (ByVal sourceDataTable As System.Data.DataTable) _
                As ADODB.Recordset

        Dim intCt As Integer = sourceDataTable.Rows.Count

        Dim sourceColumn As System.Data.DataColumn
        Dim sourceRow As System.Data.DataRow

        Dim targetRecordset As ADODB.Recordset
        Dim targetFieldAttribute As ADODB.FieldAttributeEnum

        Dim I As Integer

        targetRecordset = New ADODB.Recordset
        Try

            targetRecordset.CursorLocation = ADODB.CursorLocationEnum. _
                adUseClient

            ' iterate through each DataColumn from the source data table
            ' and create a new ADO field for each. 
            For Each sourceColumn In sourceDataTable.Columns

                ' the targetRecordset.Fields.Append method requires
                ' a values for this attribute. 
                If (sourceColumn.AllowDBNull) Then

                    targetFieldAttribute = _
                        ADODB.FieldAttributeEnum.adFldIsNullable
                Else
                    targetFieldAttribute = _
                        ADODB.FieldAttributeEnum.adFldUnspecified
                End If
                targetRecordset.Fields.Append( _
                    sourceColumn.ColumnName, _
                    translateType(sourceColumn.DataType), _
                    sourceColumn.MaxLength, _
                    targetFieldAttribute, _
                    Nothing)
            Next

            If targetRecordset.State = adStateOpen Then
                targetRecordset.Close()
            End If

            ' open the recordset for input.
            targetRecordset.Open( _
                System.Reflection.Missing.Value, _
                System.Reflection.Missing.Value, _
                ADODB.CursorTypeEnum.adOpenStatic, _
                ADODB.LockTypeEnum.adLockOptimistic, _
                0)

            ' for each row in the source DataTable, create a new recordset
            ' row and copy entries to the newly created row
            Dim strSourceType As String = ""
            For Each sourceRow In sourceDataTable.Rows

                targetRecordset.AddNew( _
                    System.Reflection.Missing.Value, _
                    System.Reflection.Missing.Value)

                For I = 0 To sourceDataTable.Columns.Count - 1
                    strSourceType = LCase(sourceRow(I).GetType.ToString)
                    If strSourceType = LCase("Microsoft.SqlServer.Types.SqlHierarchyId") _
                        Or strSourceType = LCase("Microsoft.SqlServer.Types.SqlGeography") Then

                        targetRecordset.Fields(I).Value = sourceRow(I).ToString

                    Else

                        targetRecordset.Fields(I).Value = sourceRow(I)

                    End If

                Next I

            Next

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If

        End Try

        ConvertToADORecordset = targetRecordset

    End Function

    '
    '
    '
    Private Function translateType _
            (ByVal sourceColumnType As System.Type) _
            As ADODB.DataTypeEnum


        Dim errReturn As ADODB.DataTypeEnum = ADODB.DataTypeEnum.adIUnknown

        Try

            Select Case sourceColumnType.UnderlyingSystemType.ToString()

                Case "System.Boolean"
                    Return ADODB.DataTypeEnum.adBoolean

                Case "System.Byte"
                    Return ADODB.DataTypeEnum.adUnsignedTinyInt

                Case "System.Char"
                    Return ADODB.DataTypeEnum.adChar

                Case "System.DateTime"
                    Return ADODB.DataTypeEnum.adDate

                Case "System.Decimal"
                    Return ADODB.DataTypeEnum.adCurrency

                Case "System.Double"
                    Return ADODB.DataTypeEnum.adDouble

                Case "System.Int16"
                    Return ADODB.DataTypeEnum.adSmallInt

                Case "System.Int32"
                    Return ADODB.DataTypeEnum.adInteger

                Case "System.Int64"
                    Return ADODB.DataTypeEnum.adBigInt

                Case "System.SByte"
                    Return ADODB.DataTypeEnum.adTinyInt

                Case "System.Single"
                    Return ADODB.DataTypeEnum.adSingle

                Case "System.UInt16"
                    Return ADODB.DataTypeEnum.adUnsignedSmallInt

                Case "System.UInt32"
                    Return ADODB.DataTypeEnum.adUnsignedInt

                Case "System.UInt64"
                    Return ADODB.DataTypeEnum.adUnsignedBigInt

                Case "System.String"
                    Return ADODB.DataTypeEnum.adLongVarWChar

                Case "Microsoft.SqlServer.Types.SqlHierarchyId"
                    Return ADODB.DataTypeEnum.adBSTR

                Case "Microsoft.SqlServer.Types.SqlGeography"
                    Return ADODB.DataTypeEnum.adBSTR

                Case Else
                    Return ADODB.DataTypeEnum.adLongVarWChar

            End Select

        Catch com As COMException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(com, "Com+ Policy")
            If (rethrow) Then
                Throw
            End If
        Catch ex As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(ex, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return errReturn

    End Function


#End Region




    Public Sub New()

    End Sub


    Public Sub New(ByVal visioApplication As Visio.Application)

        drawingApplication = visioApplication
        drawingWindow = visioApplication.ActiveWindow
        drawingDocument = visioApplication.ActiveDocument
        drawingPage = visioApplication.ActivePage


    End Sub

End Class
